|
Lines 57-62
BEGIN {
Link Here
|
| 57 |
PrepHostMarcField |
57 |
PrepHostMarcField |
| 58 |
CountItemsIssued |
58 |
CountItemsIssued |
| 59 |
CountBiblioInOrders |
59 |
CountBiblioInOrders |
|
|
60 |
GetMarcPermissionsRules |
| 61 |
GetMarcPermissionsModules |
| 62 |
ModMarcPermissionsRule |
| 63 |
AddMarcPermissionsRule |
| 64 |
DelMarcPermissionsRule |
| 60 |
ModBiblio |
65 |
ModBiblio |
| 61 |
ModZebra |
66 |
ModZebra |
| 62 |
UpdateTotalIssues |
67 |
UpdateTotalIssues |
|
Lines 64-69
BEGIN {
Link Here
|
| 64 |
DelBiblio |
69 |
DelBiblio |
| 65 |
BiblioAutoLink |
70 |
BiblioAutoLink |
| 66 |
LinkBibHeadingsToAuthorities |
71 |
LinkBibHeadingsToAuthorities |
|
|
72 |
ApplyMarcPermissions |
| 67 |
TransformMarcToKoha |
73 |
TransformMarcToKoha |
| 68 |
TransformHtmlToMarc |
74 |
TransformHtmlToMarc |
| 69 |
TransformHtmlToXml |
75 |
TransformHtmlToXml |
|
Lines 110-116
use Koha::Libraries;
Link Here
|
| 110 |
|
116 |
|
| 111 |
use vars qw($debug $cgi_debug); |
117 |
use vars qw($debug $cgi_debug); |
| 112 |
|
118 |
|
| 113 |
|
|
|
| 114 |
=head1 NAME |
119 |
=head1 NAME |
| 115 |
|
120 |
|
| 116 |
C4::Biblio - cataloging management functions |
121 |
C4::Biblio - cataloging management functions |
|
Lines 240-246
sub AddBiblio {
Link Here
|
| 240 |
|
245 |
|
| 241 |
=head2 ModBiblio |
246 |
=head2 ModBiblio |
| 242 |
|
247 |
|
| 243 |
ModBiblio( $record,$biblionumber,$frameworkcode); |
248 |
ModBiblio($record, $biblionumber, $frameworkcode, $options); |
| 244 |
|
249 |
|
| 245 |
Replace an existing bib record identified by C<$biblionumber> |
250 |
Replace an existing bib record identified by C<$biblionumber> |
| 246 |
with one supplied by the MARC::Record object C<$record>. The embedded |
251 |
with one supplied by the MARC::Record object C<$record>. The embedded |
|
Lines 261-267
Returns 1 on success 0 on failure
Link Here
|
| 261 |
=cut |
266 |
=cut |
| 262 |
|
267 |
|
| 263 |
sub ModBiblio { |
268 |
sub ModBiblio { |
| 264 |
my ( $record, $biblionumber, $frameworkcode ) = @_; |
269 |
my ( $record, $biblionumber, $frameworkcode, $options ) = @_; |
|
|
270 |
$options //= {}; |
| 271 |
|
| 265 |
if (!$record) { |
272 |
if (!$record) { |
| 266 |
carp 'No record passed to ModBiblio'; |
273 |
carp 'No record passed to ModBiblio'; |
| 267 |
return 0; |
274 |
return 0; |
|
Lines 293-298
sub ModBiblio {
Link Here
|
| 293 |
|
300 |
|
| 294 |
_strip_item_fields($record, $frameworkcode); |
301 |
_strip_item_fields($record, $frameworkcode); |
| 295 |
|
302 |
|
|
|
303 |
# apply permissions |
| 304 |
if (C4::Context->preference('MARCPermissions') && $biblionumber && defined $options && exists $options->{'context'}) { |
| 305 |
$record = ApplyMarcPermissions({ |
| 306 |
biblionumber => $biblionumber, |
| 307 |
record => $record, |
| 308 |
filter => $options->{'context'}, |
| 309 |
} |
| 310 |
); |
| 311 |
} |
| 312 |
|
| 296 |
# update biblionumber and biblioitemnumber in MARC |
313 |
# update biblionumber and biblioitemnumber in MARC |
| 297 |
# FIXME - this is assuming a 1 to 1 relationship between |
314 |
# FIXME - this is assuming a 1 to 1 relationship between |
| 298 |
# biblios and biblioitems |
315 |
# biblios and biblioitems |
|
Lines 303-315
sub ModBiblio {
Link Here
|
| 303 |
_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); |
320 |
_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); |
| 304 |
|
321 |
|
| 305 |
# load the koha-table data object |
322 |
# load the koha-table data object |
| 306 |
my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode ); |
323 |
my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode, undef, $biblionumber); |
| 307 |
|
324 |
|
| 308 |
# update MARC subfield that stores biblioitems.cn_sort |
325 |
# update MARC subfield that stores biblioitems.cn_sort |
| 309 |
_koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode ); |
326 |
_koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode ); |
| 310 |
|
327 |
|
| 311 |
# update the MARC record (that now contains biblio and items) with the new record data |
328 |
# update the MARC record (that now contains biblio and items) with the new record data |
| 312 |
&ModBiblioMarc( $record, $biblionumber, $frameworkcode ); |
329 |
ModBiblioMarc( $record, $biblionumber, $frameworkcode ); |
| 313 |
|
330 |
|
| 314 |
# modify the other koha tables |
331 |
# modify the other koha tables |
| 315 |
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); |
332 |
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); |
|
Lines 2525-2531
sub TransformHtmlToMarc {
Link Here
|
| 2525 |
|
2542 |
|
| 2526 |
=head2 TransformMarcToKoha |
2543 |
=head2 TransformMarcToKoha |
| 2527 |
|
2544 |
|
| 2528 |
$result = TransformMarcToKoha( $record, undef, $limit ) |
2545 |
$result = TransformMarcToKoha($record, undef, $biblionumber, $option) |
| 2529 |
|
2546 |
|
| 2530 |
Extract data from a MARC bib record into a hashref representing |
2547 |
Extract data from a MARC bib record into a hashref representing |
| 2531 |
Koha biblio, biblioitems, and items fields. |
2548 |
Koha biblio, biblioitems, and items fields. |
|
Lines 2536-2542
hash_ref.
Link Here
|
| 2536 |
=cut |
2553 |
=cut |
| 2537 |
|
2554 |
|
| 2538 |
sub TransformMarcToKoha { |
2555 |
sub TransformMarcToKoha { |
| 2539 |
my ( $record, $frameworkcode, $limit_table ) = @_; |
2556 |
my ( $record, $frameworkcode, $limit_table, $biblionumber ) = @_; |
| 2540 |
# FIXME Parameter $frameworkcode is obsolete and will be removed |
2557 |
# FIXME Parameter $frameworkcode is obsolete and will be removed |
| 2541 |
$limit_table //= q{}; |
2558 |
$limit_table //= q{}; |
| 2542 |
|
2559 |
|
|
Lines 3223-3229
sub _koha_delete_biblio_metadata {
Link Here
|
| 3223 |
|
3240 |
|
| 3224 |
=head2 ModBiblioMarc |
3241 |
=head2 ModBiblioMarc |
| 3225 |
|
3242 |
|
| 3226 |
&ModBiblioMarc($newrec,$biblionumber,$frameworkcode); |
3243 |
&ModBiblioMarc($newrec, $biblionumber, $frameworkcode, $options); |
| 3227 |
|
3244 |
|
| 3228 |
Add MARC XML data for a biblio to koha |
3245 |
Add MARC XML data for a biblio to koha |
| 3229 |
|
3246 |
|
|
Lines 3550-3557
sub RemoveAllNsb {
Link Here
|
| 3550 |
return $record; |
3567 |
return $record; |
| 3551 |
} |
3568 |
} |
| 3552 |
|
3569 |
|
| 3553 |
1; |
3570 |
=head2 ApplyMarcPermissions |
|
|
3571 |
|
| 3572 |
my $record = ApplyMarcPermissions($arguments) |
| 3573 |
|
| 3574 |
Applies marc permission rules to a record. |
| 3575 |
|
| 3576 |
C<$arguments> is expected to be a hashref with below keys defined. |
| 3577 |
|
| 3578 |
=over 4 |
| 3579 |
|
| 3580 |
=item C<biblionumber> |
| 3581 |
biblionumber of old record |
| 3582 |
|
| 3583 |
=item C<record> |
| 3584 |
record that will modify old record |
| 3585 |
|
| 3586 |
=item C<frameworkcode> |
| 3587 |
only tags included in framework will be processed |
| 3588 |
|
| 3589 |
=item C<filter> |
| 3590 |
hashref containing at least one filter module from the marc_permissions_modules |
| 3591 |
table in form {module => filter}. Three predefined filter modules exists: |
| 3592 |
|
| 3593 |
* source |
| 3594 |
* category |
| 3595 |
* borrower |
| 3596 |
|
| 3597 |
=item C<log> |
| 3598 |
optional reference to array that will be filled with rule evaluation log |
| 3599 |
entries. |
| 3600 |
|
| 3601 |
=item C<nolog> |
| 3602 |
optional boolean which when true disables logging to action log. |
| 3603 |
|
| 3604 |
=back |
| 3605 |
|
| 3606 |
Returns: |
| 3607 |
|
| 3608 |
=over 4 |
| 3609 |
|
| 3610 |
=item C<$record> |
| 3611 |
|
| 3612 |
new MARC record based on C<record> with C<filter> applied. If no old |
| 3613 |
record for C<biblionumber> can be found, C<record> is returned unchanged. |
| 3614 |
Default action when no matching filter found is to leave old record unchanged. |
| 3615 |
|
| 3616 |
=back |
| 3617 |
|
| 3618 |
=cut |
| 3619 |
|
| 3620 |
sub ApplyMarcPermissions { |
| 3621 |
my ($arguments) = @_; |
| 3622 |
my $biblionumber = $arguments->{biblionumber}; |
| 3623 |
my $incoming_record = $arguments->{record}; |
| 3624 |
|
| 3625 |
if ( !$biblionumber ) { |
| 3626 |
carp 'ApplyMarcPermissions called on undefined biblionumber'; |
| 3627 |
return; |
| 3628 |
} |
| 3629 |
if ( !$incoming_record ) { |
| 3630 |
carp 'ApplyMarcPermissions called on undefined record'; |
| 3631 |
return; |
| 3632 |
} |
| 3633 |
my $old_record = GetMarcBiblio({ biblionumber => $biblionumber }); |
| 3634 |
|
| 3635 |
my $merge_rules = undef; |
| 3636 |
if ($old_record && $arguments->{filter} && ($merge_rules = GetMarcPermissions($arguments->{filter}))) { |
| 3637 |
return MergeRecords($old_record, $incoming_record, $merge_rules); |
| 3638 |
} |
| 3639 |
return $incoming_record; |
| 3640 |
} |
| 3641 |
|
| 3642 |
sub MergeRecords { |
| 3643 |
my ($old_record, $incoming_record, $merge_rules) = @_; |
| 3644 |
my $is_matching_regex = sub { |
| 3645 |
my ( $tag, $m ) = @_; |
| 3646 |
|
| 3647 |
# tag is not exactly same as possible regex |
| 3648 |
$tag ne $m && |
| 3649 |
|
| 3650 |
# wildcard |
| 3651 |
$m ne '*' && |
| 3652 |
|
| 3653 |
# valid tagDataType |
| 3654 |
$m !~ /^(0[1-9A-z][\dA-Z]) | |
| 3655 |
([1-9A-z][\dA-z]{2})$/x && |
| 3656 |
|
| 3657 |
# nor valid controltagDataType |
| 3658 |
$m !~ /00[1-9A-Za-z]{1}/ && |
| 3659 |
|
| 3660 |
# so we try it as a regex |
| 3661 |
$tag =~ /^$m$/ |
| 3662 |
}; |
| 3663 |
|
| 3664 |
my $fields_by_tag = sub { |
| 3665 |
my ($record) = @_; |
| 3666 |
my $fields = {}; |
| 3667 |
foreach my $field ($record->fields()) { |
| 3668 |
$fields->{$field->tag()} //= []; |
| 3669 |
push @{$fields->{$field->tag()}}, $field; |
| 3670 |
} |
| 3671 |
return $fields; |
| 3672 |
}; |
| 3673 |
|
| 3674 |
my $hash_field_data = sub { |
| 3675 |
my ($field) = @_; |
| 3676 |
my $indicators = join("\x1E", map { $field->indicator($_) } (1, 2)); |
| 3677 |
return $indicators . "\x1E" . join("\x1E", sort map { join "\x1E", @{$_} } $field->subfields()); |
| 3678 |
}; |
| 3679 |
|
| 3680 |
my $diff_by_key = sub { |
| 3681 |
my ($a, $b) = @_; |
| 3682 |
my @removed; |
| 3683 |
my @intersecting; |
| 3684 |
my @added; |
| 3685 |
my %keys_index = map { $_ => undef } (keys %{$a}, keys %{$b}); |
| 3686 |
foreach my $key (keys %keys_index) { |
| 3687 |
if ($a->{$key} && $b->{$key}) { |
| 3688 |
push @intersecting, $a->{$key}; |
| 3689 |
} |
| 3690 |
elsif ($a->{$key}) { |
| 3691 |
push @removed, $a->{$key}; |
| 3692 |
} |
| 3693 |
else { |
| 3694 |
push @added, $b->{$key}; |
| 3695 |
} |
| 3696 |
} |
| 3697 |
return (\@removed, \@intersecting, \@added); |
| 3698 |
}; |
| 3699 |
|
| 3700 |
my $get_matching_field_rule = sub { |
| 3701 |
my ($tag) = @_; |
| 3702 |
my $matched_rule = undef; |
| 3703 |
# Exact match takes precedence |
| 3704 |
if (exists $merge_rules->{$tag}) { |
| 3705 |
$matched_rule = $merge_rules->{$tag}; |
| 3706 |
} |
| 3707 |
else { |
| 3708 |
# TODO: sorty by module/weight rule id or something, grab first matching via listutils thingy |
| 3709 |
my @matching_rules = map { $merge_rules->{$_} } grep { $is_matching_regex->($tag, $_) } sort keys %{$merge_rules}; |
| 3710 |
# TODO: fix |
| 3711 |
if (@matching_rules) { |
| 3712 |
$matched_rule = pop @matching_rules; |
| 3713 |
} |
| 3714 |
elsif($merge_rules->{'*'}) { |
| 3715 |
$matched_rule = $merge_rules->{'*'}; |
| 3716 |
} |
| 3717 |
} |
| 3718 |
return $matched_rule; |
| 3719 |
}; |
| 3720 |
|
| 3721 |
my $merged_record = MARC::Record->new(); |
| 3722 |
my @merged_record_fields; |
| 3723 |
|
| 3724 |
# Leader is always overwritten, or kept??? |
| 3725 |
$merged_record->leader($incoming_record->leader()); |
| 3726 |
|
| 3727 |
my $current_fields = $fields_by_tag->($old_record); |
| 3728 |
my $incoming_fields = $fields_by_tag->($incoming_record); |
| 3729 |
|
| 3730 |
# First we get all new incoming control fields |
| 3731 |
my @new_field_tags = grep { !(exists $current_fields->{$_}) } keys %{$incoming_fields}; |
| 3732 |
|
| 3733 |
foreach my $tag (@new_field_tags) { |
| 3734 |
my $rule = $get_matching_field_rule->($tag) // { |
| 3735 |
on_new => {'action' => 'skip', 'rule' => 0} |
| 3736 |
}; |
| 3737 |
if ( |
| 3738 |
$rule->{on_new}->{action} eq 'add' || |
| 3739 |
$rule->{on_new}->{action} eq 'overwrite' # ??? |
| 3740 |
) { # Or could just be write/protect? |
| 3741 |
# Hmm, only one control field possible?? |
| 3742 |
push @merged_record_fields, @{$incoming_fields->{$tag}}; |
| 3743 |
} |
| 3744 |
} |
| 3745 |
|
| 3746 |
# Then we get all control fields no longer present in incoming fields |
| 3747 |
# (removed) |
| 3748 |
my @deleted_field_tags = grep { !(exists $incoming_fields->{$_}) } keys %{$current_fields}; |
| 3749 |
foreach my $tag (@deleted_field_tags) { |
| 3750 |
my $rule = $get_matching_field_rule->($tag) // { |
| 3751 |
on_deleted => {'action' => 'skip', 'rule' => 0} |
| 3752 |
}; |
| 3753 |
if ($rule->{on_deleted}->{action} eq 'skip') { |
| 3754 |
push @merged_record_fields, @{$current_fields->{$tag}}; |
| 3755 |
} |
| 3756 |
} |
| 3757 |
|
| 3758 |
# Then we get the intersection of control fields, present both in |
| 3759 |
# current and incoming record (possibly to be overwritten) |
| 3760 |
my @common_field_tags = grep { exists $incoming_fields->{$_} } keys %{$current_fields}; |
| 3761 |
foreach my $tag (@common_field_tags) { |
| 3762 |
# Is control field |
| 3763 |
my $rule = $get_matching_field_rule->($tag) // { |
| 3764 |
on_removed => {'action' => 'skip', 'rule' => 0}, |
| 3765 |
on_appended => {'action' => 'skip', 'rule' => 0} |
| 3766 |
}; |
| 3767 |
if ($tag < 10) { |
| 3768 |
# on_existing = on_match |
| 3769 |
if ($rule->{on_appended}->{action} eq 'skip') { # TODO: replace with "protect", "keep" |
| 3770 |
push @merged_record_fields, @{$current_fields->{$tag}}; |
| 3771 |
} |
| 3772 |
elsif ($rule->{on_appended}->{action} eq 'append') { |
| 3773 |
push @merged_record_fields, @{$incoming_fields->{$tag}}; |
| 3774 |
} |
| 3775 |
if ( |
| 3776 |
$rule->{on_appended}->{action} eq 'append' && |
| 3777 |
$rule->{on_removed}->{action} eq 'skip' |
| 3778 |
) { |
| 3779 |
#TODO: This is an invalid combination for control fields, warn!! |
| 3780 |
# Or should perform client/server side validation to prevent this choice |
| 3781 |
} |
| 3782 |
} |
| 3783 |
else { |
| 3784 |
# Compute intersection and diff using field data |
| 3785 |
my %current_fields_by_data = map { $hash_field_data->($_) => $_ } @{$current_fields->{$tag}}; |
| 3786 |
my %incoming_fields_by_data = map { $hash_field_data->($_) => $_ } @{$incoming_fields->{$tag}}; |
| 3787 |
my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data); |
| 3788 |
|
| 3789 |
# First add common fields (intersection) |
| 3790 |
# Unchanged |
| 3791 |
if (@{$common_fields}) { |
| 3792 |
push @merged_record_fields, @{$common_fields}; |
| 3793 |
} |
| 3794 |
# Removed |
| 3795 |
if (@{$current_fields_only}) { |
| 3796 |
if ($rule->{on_removed}->{action} eq 'skip') { |
| 3797 |
push @merged_record_fields, @{$current_fields_only}; |
| 3798 |
} |
| 3799 |
} |
| 3800 |
# Appended |
| 3801 |
if (@{$incoming_fields_only}) { |
| 3802 |
if ($rule->{on_appended}->{action} eq 'append') { |
| 3803 |
push @merged_record_fields, @{$incoming_fields_only}; |
| 3804 |
} |
| 3805 |
} |
| 3806 |
} |
| 3807 |
} |
| 3808 |
if ($#merged_record_fields != 0) { |
| 3809 |
$merged_record->insert_fields_ordered(@merged_record_fields); |
| 3810 |
} |
| 3811 |
return $merged_record; |
| 3812 |
} |
| 3813 |
|
| 3814 |
=head2 GetMarcPermissions |
| 3815 |
|
| 3816 |
my $marc_permissions = GetMarcPermissions() |
| 3817 |
|
| 3818 |
Loads MARC field permissions from the marc_permissions table. |
| 3819 |
|
| 3820 |
Returns: |
| 3821 |
|
| 3822 |
=over 4 |
| 3823 |
|
| 3824 |
=item C<$marc_permissions> |
| 3825 |
|
| 3826 |
hashref with permissions structure for use with GetMarcPermissionsAction. |
| 3827 |
|
| 3828 |
=back |
| 3829 |
|
| 3830 |
=cut |
| 3831 |
|
| 3832 |
sub GetMarcPermissions { |
| 3833 |
my ($filter) = @_; |
| 3834 |
my $dbh = C4::Context->dbh; |
| 3835 |
my $rule_count = 0; |
| 3836 |
my $modules = GetMarcPermissionsModules(); |
| 3837 |
# We only care about modules included in the context/filter |
| 3838 |
# TODO: Perhaps make sure source => '*' is default? |
| 3839 |
my @filter_modules = grep { exists $filter->{$_->{name}} } @{$modules}; |
| 3840 |
|
| 3841 |
my $cache = Koha::Caches->get_instance(); |
| 3842 |
my $permissions = $cache->get_from_cache('marc_permissions', { unsafe => 1 }); |
| 3843 |
|
| 3844 |
if (!$permissions) { |
| 3845 |
my $query = ' |
| 3846 |
SELECT `marc_permissions`.*, |
| 3847 |
`marc_permissions_modules`.`name`, |
| 3848 |
`marc_permissions_modules`.`description`, |
| 3849 |
`marc_permissions_modules`.`specificity` |
| 3850 |
FROM `marc_permissions` |
| 3851 |
LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` |
| 3852 |
ORDER BY `marc_permissions_modules`.`specificity`, `id` |
| 3853 |
'; |
| 3854 |
my $sth = $dbh->prepare($query); |
| 3855 |
$sth->execute(); |
| 3856 |
while (my $perm = $sth->fetchrow_hashref) { |
| 3857 |
my $target = ($permissions->{$perm->{name}}->{$perm->{filter}}->{$perm->{tagfield}} //= {}); |
| 3858 |
foreach my $event (GetMarcPermissionEvents()) { |
| 3859 |
$target->{$event} = { action => $perm->{$event}, rule => $perm->{'id'} }; |
| 3860 |
} |
| 3861 |
} |
| 3862 |
$cache->set_in_cache('marc_permissions', $permissions); |
| 3863 |
} |
| 3864 |
|
| 3865 |
my $filtered_permissions = undef; |
| 3866 |
foreach my $module (@filter_modules) { |
| 3867 |
if ( |
| 3868 |
exists $permissions->{$module->{name}} && |
| 3869 |
exists $permissions->{$module->{name}}->{$filter->{$module->{name}}} |
| 3870 |
) { |
| 3871 |
# TODO: Support multiple overlapping filters/context?? |
| 3872 |
$filtered_permissions = $permissions->{$module->{name}}->{$filter->{$module->{name}}}; |
| 3873 |
last; |
| 3874 |
} |
| 3875 |
} |
| 3876 |
if (!$filtered_permissions) { |
| 3877 |
# No perms matching specific context conditions found, try wildcard value for each active context |
| 3878 |
foreach my $module (@filter_modules) { |
| 3879 |
if (exists $permissions->{$module->{name}}->{'*'}) { |
| 3880 |
$filtered_permissions = $permissions->{$module->{name}}->{'*'}; |
| 3881 |
last; |
| 3882 |
} |
| 3883 |
} |
| 3884 |
} |
| 3885 |
return $filtered_permissions; |
| 3886 |
} |
| 3887 |
|
| 3888 |
# TODO: Use this in GetMarcPermissions |
| 3889 |
=head2 GetMarcPermissionsRules |
| 3890 |
|
| 3891 |
my $rules = GetMarcPermissionsRules() |
| 3892 |
|
| 3893 |
Returns: |
| 3894 |
|
| 3895 |
=over 4 |
| 3896 |
|
| 3897 |
=item C<$rules> |
| 3898 |
|
| 3899 |
array (in list context, arrayref otherwise) of hashrefs from marc_permissions |
| 3900 |
table in order of module specificity and rule id. |
| 3901 |
|
| 3902 |
=back |
| 3903 |
|
| 3904 |
=cut |
| 3905 |
|
| 3906 |
sub GetMarcPermissionsRules { |
| 3907 |
my $dbh = C4::Context->dbh; |
| 3908 |
my @rules = (); |
| 3909 |
|
| 3910 |
my $query = ' |
| 3911 |
SELECT `marc_permissions`.`id`, |
| 3912 |
`marc_permissions`.`tagfield`, |
| 3913 |
`marc_permissions`.`filter`, |
| 3914 |
`marc_permissions`.`on_new`, |
| 3915 |
`marc_permissions`.`on_appended`, |
| 3916 |
`marc_permissions`.`on_removed`, |
| 3917 |
`marc_permissions`.`on_deleted`, |
| 3918 |
`marc_permissions_modules`.`name` as `module`, |
| 3919 |
`marc_permissions_modules`.`description`, |
| 3920 |
`marc_permissions_modules`.`specificity` |
| 3921 |
FROM `marc_permissions` |
| 3922 |
LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` |
| 3923 |
ORDER BY `marc_permissions_modules`.`specificity`, `id` |
| 3924 |
'; |
| 3925 |
my $sth = $dbh->prepare($query); |
| 3926 |
$sth->execute(); |
| 3927 |
while ( my $row = $sth->fetchrow_hashref ) { |
| 3928 |
push(@rules, $row); |
| 3929 |
} |
| 3930 |
|
| 3931 |
return wantarray ? @rules : \@rules; |
| 3932 |
} |
| 3933 |
|
| 3934 |
=head2 GetMarcPermissionsModules |
| 3935 |
|
| 3936 |
my $modules = GetMarcPermissionsModules() |
| 3937 |
|
| 3938 |
Returns: |
| 3939 |
|
| 3940 |
=over 4 |
| 3941 |
|
| 3942 |
=item C<$modules> |
| 3943 |
|
| 3944 |
array (in list context, arrayref otherwise) of hashrefs from |
| 3945 |
marc_permissions_modules table in order of specificity. |
| 3946 |
|
| 3947 |
=back |
| 3948 |
|
| 3949 |
=cut |
| 3554 |
|
3950 |
|
|
|
3951 |
sub GetMarcPermissionsModules { |
| 3952 |
my $dbh = C4::Context->dbh; |
| 3953 |
my @modules = (); |
| 3954 |
|
| 3955 |
my $query = ' |
| 3956 |
SELECT * |
| 3957 |
FROM `marc_permissions_modules` |
| 3958 |
ORDER BY `specificity` DESC |
| 3959 |
'; |
| 3960 |
my $sth = $dbh->prepare($query); |
| 3961 |
$sth->execute(); |
| 3962 |
while ( my $row = $sth->fetchrow_hashref ) { |
| 3963 |
push(@modules, $row); |
| 3964 |
} |
| 3965 |
|
| 3966 |
return wantarray ? @modules : \@modules; |
| 3967 |
} |
| 3968 |
|
| 3969 |
sub GetMarcPermissionEvents { |
| 3970 |
return ('on_new', 'on_appended', 'on_removed', 'on_deleted'); |
| 3971 |
} |
| 3972 |
|
| 3973 |
=head2 ModMarcPermissionsRule |
| 3974 |
|
| 3975 |
my $success = ModMarcPermissionsRule($id, $fields) |
| 3976 |
|
| 3977 |
Modifies rule in the marc_permissions table. |
| 3978 |
|
| 3979 |
=over 4 |
| 3980 |
|
| 3981 |
=item C<$id> |
| 3982 |
|
| 3983 |
rule id to modify |
| 3984 |
|
| 3985 |
=item C<$fields> |
| 3986 |
|
| 3987 |
hashref defining the table fields |
| 3988 |
|
| 3989 |
* tagfield - required |
| 3990 |
* module - required |
| 3991 |
* filter - required |
| 3992 |
* on_new - required |
| 3993 |
* on_appended - required |
| 3994 |
* on_removed - required |
| 3995 |
* on_deleted - required |
| 3996 |
|
| 3997 |
=back |
| 3998 |
|
| 3999 |
Returns: |
| 4000 |
|
| 4001 |
=over 4 |
| 4002 |
|
| 4003 |
=item C<$success> |
| 4004 |
|
| 4005 |
undef if an error occurs, otherwise true. |
| 4006 |
|
| 4007 |
=back |
| 4008 |
|
| 4009 |
=cut |
| 4010 |
|
| 4011 |
sub ModMarcPermissionsRule { |
| 4012 |
my ($id, $f) = @_; |
| 4013 |
my $dbh = C4::Context->dbh; |
| 4014 |
|
| 4015 |
my $query = ' |
| 4016 |
UPDATE `marc_permissions` |
| 4017 |
SET |
| 4018 |
tagfield = ?, |
| 4019 |
module = ?, |
| 4020 |
filter = ?, |
| 4021 |
on_new = ?, |
| 4022 |
on_appended = ?, |
| 4023 |
on_removed = ?, |
| 4024 |
on_deleted = ? |
| 4025 |
WHERE |
| 4026 |
id = ? |
| 4027 |
'; |
| 4028 |
my $sth = $dbh->prepare($query); |
| 4029 |
my $result = $sth->execute ( |
| 4030 |
$f->{tagfield}, |
| 4031 |
$f->{module}, |
| 4032 |
$f->{filter}, |
| 4033 |
$f->{on_new}, |
| 4034 |
$f->{on_appended}, |
| 4035 |
$f->{on_removed}, |
| 4036 |
$f->{on_deleted}, |
| 4037 |
$id |
| 4038 |
); |
| 4039 |
ClearMarcPermissionsRulesCache(); |
| 4040 |
return $result; |
| 4041 |
} |
| 4042 |
|
| 4043 |
sub ClearMarcPermissionsRulesCache { |
| 4044 |
my $cache = Koha::Caches->get_instance(); |
| 4045 |
$cache->clear_from_cache('marc_permissions'); |
| 4046 |
} |
| 4047 |
|
| 4048 |
=head2 AddMarcPermissionsRule |
| 4049 |
|
| 4050 |
my $success = AddMarcPermissionsRule($fields) |
| 4051 |
|
| 4052 |
Add rule to the marc_permissions table. |
| 4053 |
|
| 4054 |
=over 4 |
| 4055 |
|
| 4056 |
=item C<$fields> |
| 4057 |
|
| 4058 |
hashref defining the table fields |
| 4059 |
|
| 4060 |
tagfield - required |
| 4061 |
module - required |
| 4062 |
filter - required |
| 4063 |
on_new - required |
| 4064 |
on_appended - required |
| 4065 |
on_removed - required |
| 4066 |
on_deleted - required |
| 4067 |
|
| 4068 |
=back |
| 4069 |
|
| 4070 |
Returns: |
| 4071 |
|
| 4072 |
=over 4 |
| 4073 |
|
| 4074 |
=item C<$success> |
| 4075 |
|
| 4076 |
undef if an error occurs, otherwise true. |
| 4077 |
|
| 4078 |
=back |
| 4079 |
|
| 4080 |
=cut |
| 4081 |
|
| 4082 |
sub AddMarcPermissionsRule { |
| 4083 |
my $f = shift; |
| 4084 |
my $dbh = C4::Context->dbh; |
| 4085 |
my $query = ' |
| 4086 |
INSERT INTO `marc_permissions` |
| 4087 |
( |
| 4088 |
tagfield, |
| 4089 |
module, |
| 4090 |
filter, |
| 4091 |
on_new, |
| 4092 |
on_appended, |
| 4093 |
on_removed, |
| 4094 |
on_deleted |
| 4095 |
) |
| 4096 |
VALUES (?, ?, ?, ?, ?, ?, ?) |
| 4097 |
'; |
| 4098 |
my $sth = $dbh->prepare($query); |
| 4099 |
my $result = $sth->execute ( |
| 4100 |
$f->{tagfield}, |
| 4101 |
$f->{module}, |
| 4102 |
$f->{filter}, |
| 4103 |
$f->{on_new}, |
| 4104 |
$f->{on_appended}, |
| 4105 |
$f->{on_removed}, |
| 4106 |
$f->{on_deleted} |
| 4107 |
); |
| 4108 |
ClearMarcPermissionsRulesCache(); |
| 4109 |
return $result; |
| 4110 |
} |
| 4111 |
|
| 4112 |
=head2 DelMarcPermissionsRule |
| 4113 |
|
| 4114 |
my $success = DelMarcPermissionsRule($id) |
| 4115 |
|
| 4116 |
Deletes rule from the marc_permissions table. |
| 4117 |
|
| 4118 |
=over 4 |
| 4119 |
|
| 4120 |
=item C<$id> |
| 4121 |
|
| 4122 |
rule id to delete |
| 4123 |
|
| 4124 |
=back |
| 4125 |
|
| 4126 |
Returns: |
| 4127 |
|
| 4128 |
=over 4 |
| 4129 |
|
| 4130 |
=item C<$success> |
| 4131 |
|
| 4132 |
undef if an error occurs, otherwise true. |
| 4133 |
|
| 4134 |
=back |
| 4135 |
|
| 4136 |
=cut |
| 4137 |
|
| 4138 |
sub DelMarcPermissionsRule { |
| 4139 |
my $id = shift; |
| 4140 |
my $dbh = C4::Context->dbh; |
| 4141 |
my $query = ' |
| 4142 |
DELETE FROM `marc_permissions` |
| 4143 |
WHERE |
| 4144 |
id = ? |
| 4145 |
'; |
| 4146 |
my $sth = $dbh->prepare($query); |
| 4147 |
my $result = $sth->execute($id); |
| 4148 |
ClearMarcPermissionsRulesCache(); |
| 4149 |
return $result; |
| 4150 |
} |
| 4151 |
1; |
| 3555 |
|
4152 |
|
| 3556 |
__END__ |
4153 |
__END__ |
| 3557 |
|
4154 |
|