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; |
33 |
use Digest::MD5 qw(md5_base64); |
32 |
|
34 |
|
33 |
use C4::Koha; |
35 |
use C4::Koha; |
34 |
use C4::Log; # logaction |
36 |
use C4::Log; # logaction |
Lines 102-107
BEGIN {
Link Here
|
102 |
|
104 |
|
103 |
&CountItemsIssued |
105 |
&CountItemsIssued |
104 |
&CountBiblioInOrders |
106 |
&CountBiblioInOrders |
|
|
107 |
|
108 |
&GetMarcPermissionsRules |
109 |
&GetMarcPermissionsModules |
110 |
&ModMarcPermissionsRule |
111 |
&AddMarcPermissionsRule |
112 |
&DelMarcPermissionsRule |
105 |
); |
113 |
); |
106 |
|
114 |
|
107 |
# To modify something |
115 |
# To modify something |
Lines 129-134
BEGIN {
Link Here
|
129 |
# they are useful in a few circumstances, so they are exported, |
137 |
# they are useful in a few circumstances, so they are exported, |
130 |
# but don't use them unless you are a core developer ;-) |
138 |
# but don't use them unless you are a core developer ;-) |
131 |
push @EXPORT, qw( |
139 |
push @EXPORT, qw( |
|
|
140 |
&ApplyMarcPermissions |
132 |
&ModBiblioMarc |
141 |
&ModBiblioMarc |
133 |
); |
142 |
); |
134 |
|
143 |
|
Lines 266-272
sub AddBiblio {
Link Here
|
266 |
|
275 |
|
267 |
=head2 ModBiblio |
276 |
=head2 ModBiblio |
268 |
|
277 |
|
269 |
ModBiblio( $record,$biblionumber,$frameworkcode); |
278 |
ModBiblio($record, $biblionumber, $frameworkcode, $options); |
270 |
|
279 |
|
271 |
Replace an existing bib record identified by C<$biblionumber> |
280 |
Replace an existing bib record identified by C<$biblionumber> |
272 |
with one supplied by the MARC::Record object C<$record>. The embedded |
281 |
with one supplied by the MARC::Record object C<$record>. The embedded |
Lines 287-293
Returns 1 on success 0 on failure
Link Here
|
287 |
=cut |
296 |
=cut |
288 |
|
297 |
|
289 |
sub ModBiblio { |
298 |
sub ModBiblio { |
290 |
my ( $record, $biblionumber, $frameworkcode ) = @_; |
299 |
my ( $record, $biblionumber, $frameworkcode, $options ) = @_; |
|
|
300 |
$options //= {}; |
301 |
|
291 |
if (!$record) { |
302 |
if (!$record) { |
292 |
carp 'No record passed to ModBiblio'; |
303 |
carp 'No record passed to ModBiblio'; |
293 |
return 0; |
304 |
return 0; |
Lines 315-320
sub ModBiblio {
Link Here
|
315 |
|
326 |
|
316 |
_strip_item_fields($record, $frameworkcode); |
327 |
_strip_item_fields($record, $frameworkcode); |
317 |
|
328 |
|
|
|
329 |
# apply permissions |
330 |
if (C4::Context->preference('MARCPermissions') && $biblionumber && defined $options && exists $options->{'context'}) { |
331 |
$record = ApplyMarcPermissions({ |
332 |
biblionumber => $biblionumber, |
333 |
record => $record, |
334 |
filter => $options->{'context'}, |
335 |
} |
336 |
); |
337 |
} |
338 |
|
318 |
# update biblionumber and biblioitemnumber in MARC |
339 |
# update biblionumber and biblioitemnumber in MARC |
319 |
# FIXME - this is assuming a 1 to 1 relationship between |
340 |
# FIXME - this is assuming a 1 to 1 relationship between |
320 |
# biblios and biblioitems |
341 |
# biblios and biblioitems |
Lines 325-337
sub ModBiblio {
Link Here
|
325 |
_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); |
346 |
_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); |
326 |
|
347 |
|
327 |
# load the koha-table data object |
348 |
# load the koha-table data object |
328 |
my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode ); |
349 |
my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode, undef, $biblionumber); |
329 |
|
350 |
|
330 |
# update MARC subfield that stores biblioitems.cn_sort |
351 |
# update MARC subfield that stores biblioitems.cn_sort |
331 |
_koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode ); |
352 |
_koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode ); |
332 |
|
353 |
|
333 |
# update the MARC record (that now contains biblio and items) with the new record data |
354 |
# update the MARC record (that now contains biblio and items) with the new record data |
334 |
&ModBiblioMarc( $record, $biblionumber, $frameworkcode ); |
355 |
ModBiblioMarc( $record, $biblionumber, $frameworkcode ); |
335 |
|
356 |
|
336 |
# modify the other koha tables |
357 |
# modify the other koha tables |
337 |
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); |
358 |
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); |
Lines 2573-2579
sub TransformHtmlToMarc {
Link Here
|
2573 |
|
2594 |
|
2574 |
=head2 TransformMarcToKoha |
2595 |
=head2 TransformMarcToKoha |
2575 |
|
2596 |
|
2576 |
$result = TransformMarcToKoha( $record, undef, $limit ) |
2597 |
$result = TransformMarcToKoha($record, undef, $biblionumber, $option) |
2577 |
|
2598 |
|
2578 |
Extract data from a MARC bib record into a hashref representing |
2599 |
Extract data from a MARC bib record into a hashref representing |
2579 |
Koha biblio, biblioitems, and items fields. |
2600 |
Koha biblio, biblioitems, and items fields. |
Lines 2584-2590
hash_ref.
Link Here
|
2584 |
=cut |
2605 |
=cut |
2585 |
|
2606 |
|
2586 |
sub TransformMarcToKoha { |
2607 |
sub TransformMarcToKoha { |
2587 |
my ( $record, $frameworkcode, $limit_table ) = @_; |
2608 |
my ( $record, $frameworkcode, $limit_table, $biblionumber ) = @_; |
2588 |
# FIXME Parameter $frameworkcode is obsolete and will be removed |
2609 |
# FIXME Parameter $frameworkcode is obsolete and will be removed |
2589 |
$limit_table //= q{}; |
2610 |
$limit_table //= q{}; |
2590 |
|
2611 |
|
Lines 3271-3277
sub _koha_delete_biblio_metadata {
Link Here
|
3271 |
|
3292 |
|
3272 |
=head2 ModBiblioMarc |
3293 |
=head2 ModBiblioMarc |
3273 |
|
3294 |
|
3274 |
&ModBiblioMarc($newrec,$biblionumber,$frameworkcode); |
3295 |
&ModBiblioMarc($newrec, $biblionumber, $frameworkcode, $options); |
3275 |
|
3296 |
|
3276 |
Add MARC XML data for a biblio to koha |
3297 |
Add MARC XML data for a biblio to koha |
3277 |
|
3298 |
|
Lines 3283-3288
sub ModBiblioMarc {
Link Here
|
3283 |
# pass the MARC::Record to this function, and it will create the records in |
3304 |
# pass the MARC::Record to this function, and it will create the records in |
3284 |
# the marcxml field |
3305 |
# the marcxml field |
3285 |
my ( $record, $biblionumber, $frameworkcode ) = @_; |
3306 |
my ( $record, $biblionumber, $frameworkcode ) = @_; |
|
|
3307 |
|
3286 |
if ( !$record ) { |
3308 |
if ( !$record ) { |
3287 |
carp 'ModBiblioMarc passed an undefined record'; |
3309 |
carp 'ModBiblioMarc passed an undefined record'; |
3288 |
return; |
3310 |
return; |
Lines 3295-3300
sub ModBiblioMarc {
Link Here
|
3295 |
if ( !$frameworkcode ) { |
3317 |
if ( !$frameworkcode ) { |
3296 |
$frameworkcode = ""; |
3318 |
$frameworkcode = ""; |
3297 |
} |
3319 |
} |
|
|
3320 |
|
3298 |
my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"); |
3321 |
my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"); |
3299 |
$sth->execute( $frameworkcode, $biblionumber ); |
3322 |
$sth->execute( $frameworkcode, $biblionumber ); |
3300 |
$sth->finish; |
3323 |
$sth->finish; |
Lines 3596-3603
sub RemoveAllNsb {
Link Here
|
3596 |
return $record; |
3619 |
return $record; |
3597 |
} |
3620 |
} |
3598 |
|
3621 |
|
3599 |
1; |
3622 |
=head2 ApplyMarcPermissions |
|
|
3623 |
|
3624 |
my $record = ApplyMarcPermissions($arguments) |
3625 |
|
3626 |
Applies marc permission rules to a record. |
3627 |
|
3628 |
C<$arguments> is expected to be a hashref with below keys defined. |
3629 |
|
3630 |
=over 4 |
3631 |
|
3632 |
=item C<biblionumber> |
3633 |
biblionumber of old record |
3634 |
|
3635 |
=item C<record> |
3636 |
record that will modify old record |
3637 |
|
3638 |
=item C<frameworkcode> |
3639 |
only tags included in framework will be processed |
3640 |
|
3641 |
=item C<filter> |
3642 |
hashref containing at least one filter module from the marc_permissions_modules |
3643 |
table in form {module => filter}. Three predefined filter modules exists: |
3644 |
|
3645 |
* source |
3646 |
* category |
3647 |
* borrower |
3648 |
|
3649 |
=item C<log> |
3650 |
optional reference to array that will be filled with rule evaluation log |
3651 |
entries. |
3652 |
|
3653 |
=item C<nolog> |
3654 |
optional boolean which when true disables logging to action log. |
3655 |
|
3656 |
=back |
3657 |
|
3658 |
Returns: |
3659 |
|
3660 |
=over 4 |
3661 |
|
3662 |
=item C<$record> |
3663 |
|
3664 |
new MARC record based on C<record> with C<filter> applied. If no old |
3665 |
record for C<biblionumber> can be found, C<record> is returned unchanged. |
3666 |
Default action when no matching filter found is to leave old record unchanged. |
3667 |
|
3668 |
=back |
3669 |
|
3670 |
=cut |
3671 |
|
3672 |
sub ApplyMarcPermissions { |
3673 |
my ($arguments) = @_; |
3674 |
my $biblionumber = $arguments->{biblionumber}; |
3675 |
my $incoming_record = $arguments->{record}; |
3676 |
|
3677 |
if ( !$biblionumber ) { |
3678 |
carp 'ApplyMarcPermissions called on undefined biblionumber'; |
3679 |
return; |
3680 |
} |
3681 |
if ( !$incoming_record ) { |
3682 |
carp 'ApplyMarcPermissions called on undefined record'; |
3683 |
return; |
3684 |
} |
3685 |
my $old_record = GetMarcBiblio({ biblionumber => $biblionumber }); |
3686 |
|
3687 |
my $merge_rules = undef; |
3688 |
if ($old_record && $arguments->{filter} && ($merge_rules = GetMarcPermissions($arguments->{filter}))) { |
3689 |
return MergeRecords($old_record, $incoming_record, $merge_rules); |
3690 |
} |
3691 |
return $incoming_record; |
3692 |
} |
3693 |
|
3694 |
sub MergeRecords { |
3695 |
my ($old_record, $incoming_record, $merge_rules) = @_; |
3696 |
my $is_matching_regex = sub { |
3697 |
my ( $tag, $m ) = @_; |
3698 |
|
3699 |
# tag is not exactly same as possible regex |
3700 |
$tag ne $m && |
3701 |
|
3702 |
# wildcard |
3703 |
$m ne '*' && |
3704 |
|
3705 |
# valid tagDataType |
3706 |
$m !~ /^(0[1-9A-z][\dA-Z]) | |
3707 |
([1-9A-z][\dA-z]{2})$/x && |
3708 |
|
3709 |
# nor valid controltagDataType |
3710 |
$m !~ /00[1-9A-Za-z]{1}/ && |
3711 |
|
3712 |
# so we try it as a regex |
3713 |
$tag =~ /^$m$/ |
3714 |
}; |
3715 |
|
3716 |
my $fields_by_tag = sub { |
3717 |
my ($record) = @_; |
3718 |
my $fields = {}; |
3719 |
foreach my $field ($record->fields()) { |
3720 |
$fields->{$field->tag()} //= []; |
3721 |
push @{$fields->{$field->tag()}}, $field; |
3722 |
} |
3723 |
return $fields; |
3724 |
}; |
3725 |
|
3726 |
my $hash_field_data = sub { |
3727 |
my ($field) = @_; |
3728 |
my $indicators = join("\x1E", map { $field->indicator($_) } (1, 2)); |
3729 |
return md5_base64($indicators . "\x1E" . join("\x1E", sort map { join "\x1E", @{$_} } $field->subfields())); |
3730 |
}; |
3731 |
|
3732 |
my $diff_by_key = sub { |
3733 |
my ($a, $b) = @_; |
3734 |
my @removed; |
3735 |
my @intersecting; |
3736 |
my @added; |
3737 |
my %keys_index = map { $_ => undef } (keys %{$a}, keys %{$b}); |
3738 |
foreach my $key (keys %keys_index) { |
3739 |
if ($a->{$key} && $b->{$key}) { |
3740 |
push @intersecting, $a->{$key}; |
3741 |
} |
3742 |
elsif ($a->{$key}) { |
3743 |
push @removed, $a->{$key}; |
3744 |
} |
3745 |
else { |
3746 |
push @added, $b->{$key}; |
3747 |
} |
3748 |
} |
3749 |
return (\@removed, \@intersecting, \@added); |
3750 |
}; |
3751 |
|
3752 |
my $get_matching_field_rule = sub { |
3753 |
my ($tag) = @_; |
3754 |
my $matched_rule = undef; |
3755 |
# Exact match takes precedence |
3756 |
if (exists $merge_rules->{$tag}) { |
3757 |
$matched_rule = $merge_rules->{$tag}; |
3758 |
} |
3759 |
else { |
3760 |
# TODO: sorty by module/weight rule id or something, grab first matching via listutils thingy |
3761 |
my @matching_rules = map { $merge_rules->{$_} } grep { $is_matching_regex->($tag, $_) } sort keys %{$merge_rules}; |
3762 |
# TODO: fix |
3763 |
if (@matching_rules) { |
3764 |
$matched_rule = pop @matching_rules; |
3765 |
} |
3766 |
elsif($merge_rules->{'*'}) { |
3767 |
$matched_rule = $merge_rules->{'*'}; |
3768 |
} |
3769 |
} |
3770 |
return $matched_rule; |
3771 |
}; |
3772 |
|
3773 |
my $merged_record = MARC::Record->new(); |
3774 |
my @merged_record_fields; |
3775 |
|
3776 |
# Leader is always overwritten, or kept??? |
3777 |
$merged_record->leader($incoming_record->leader()); |
3778 |
|
3779 |
my $current_fields = $fields_by_tag->($old_record); |
3780 |
my $incoming_fields = $fields_by_tag->($incoming_record); |
3781 |
|
3782 |
# First we get all new incoming control fields |
3783 |
my @new_field_tags = grep { !(exists $current_fields->{$_}) } keys %{$incoming_fields}; |
3784 |
|
3785 |
foreach my $tag (@new_field_tags) { |
3786 |
my $rule = $get_matching_field_rule->($tag) // { |
3787 |
on_new => {'action' => 'skip', 'rule' => 0} |
3788 |
}; |
3789 |
if ( |
3790 |
$rule->{on_new}->{action} eq 'add' || |
3791 |
$rule->{on_new}->{action} eq 'overwrite' # ??? |
3792 |
) { # Or could just be write/protect? |
3793 |
# Hmm, only one control field possible?? |
3794 |
push @merged_record_fields, @{$incoming_fields->{$tag}}; |
3795 |
} |
3796 |
} |
3797 |
|
3798 |
# Then we get all control fields no longer present in incoming fields |
3799 |
# (removed) |
3800 |
my @deleted_field_tags = grep { !(exists $incoming_fields->{$_}) } keys %{$current_fields}; |
3801 |
foreach my $tag (@deleted_field_tags) { |
3802 |
my $rule = $get_matching_field_rule->($tag) // { |
3803 |
on_deleted => {'action' => 'skip', 'rule' => 0} |
3804 |
}; |
3805 |
if ($rule->{on_deleted}->{action} eq 'skip') { |
3806 |
push @merged_record_fields, @{$current_fields->{$tag}}; |
3807 |
} |
3808 |
} |
3809 |
|
3810 |
# Then we get the intersection of control fields, present both in |
3811 |
# current and incoming record (possibly to be overwritten) |
3812 |
my @common_field_tags = grep { exists $incoming_fields->{$_} } keys %{$current_fields}; |
3813 |
foreach my $tag (@common_field_tags) { |
3814 |
# Is control field |
3815 |
my $rule = $get_matching_field_rule->($tag) // { |
3816 |
on_removed => {'action' => 'skip', 'rule' => 0}, |
3817 |
on_appended => {'action' => 'skip', 'rule' => 0} |
3818 |
}; |
3819 |
if ($tag < 10) { |
3820 |
# on_existing = on_match |
3821 |
if ($rule->{on_appended}->{action} eq 'skip') { # TODO: replace with "protect", "keep" |
3822 |
push @merged_record_fields, @{$current_fields->{$tag}}; |
3823 |
} |
3824 |
elsif ($rule->{on_appended}->{action} eq 'append') { |
3825 |
push @merged_record_fields, @{$incoming_fields->{$tag}}; |
3826 |
} |
3827 |
if ( |
3828 |
$rule->{on_appended}->{action} eq 'append' && |
3829 |
$rule->{on_removed}->{action} eq 'skip' |
3830 |
) { |
3831 |
#TODO: This is an invalid combination for control fields, warn!! |
3832 |
# Or should perform client/server side validation to prevent this choice |
3833 |
} |
3834 |
} |
3835 |
else { |
3836 |
# Compute intersection and diff using field data |
3837 |
my %current_fields_by_data = map { $hash_field_data->($_) => $_ } @{$current_fields->{$tag}}; |
3838 |
my %incoming_fields_by_data = map { $hash_field_data->($_) => $_ } @{$incoming_fields->{$tag}}; |
3839 |
my ($current_fields_only, $common_fields, $incoming_fields_only) = $diff_by_key->(\%current_fields_by_data, \%incoming_fields_by_data); |
3840 |
|
3841 |
# First add common fields (intersection) |
3842 |
# Unchanged |
3843 |
if (@{$common_fields}) { |
3844 |
push @merged_record_fields, @{$common_fields}; |
3845 |
} |
3846 |
# Removed |
3847 |
if (@{$current_fields_only}) { |
3848 |
if ($rule->{on_removed}->{action} eq 'skip') { |
3849 |
push @merged_record_fields, @{$current_fields_only}; |
3850 |
} |
3851 |
} |
3852 |
# Appended |
3853 |
if (@{$incoming_fields_only}) { |
3854 |
if ($rule->{on_appended}->{action} eq 'append') { |
3855 |
push @merged_record_fields, @{$incoming_fields_only}; |
3856 |
} |
3857 |
} |
3858 |
} |
3859 |
} |
3860 |
if ($#merged_record_fields != 0) { |
3861 |
$merged_record->insert_fields_ordered(@merged_record_fields); |
3862 |
} |
3863 |
return $merged_record; |
3864 |
} |
3865 |
|
3866 |
=head2 GetMarcPermissions |
3867 |
|
3868 |
my $marc_permissions = GetMarcPermissions() |
3869 |
|
3870 |
Loads MARC field permissions from the marc_permissions table. |
3871 |
|
3872 |
Returns: |
3873 |
|
3874 |
=over 4 |
3875 |
|
3876 |
=item C<$marc_permissions> |
3877 |
|
3878 |
hashref with permissions structure for use with GetMarcPermissionsAction. |
3879 |
|
3880 |
=back |
3881 |
|
3882 |
=cut |
3883 |
|
3884 |
sub GetMarcPermissions { |
3885 |
my ($filter) = @_; |
3886 |
my $dbh = C4::Context->dbh; |
3887 |
my $rule_count = 0; |
3888 |
my $modules = GetMarcPermissionsModules(); |
3889 |
# We only care about modules included in the context/filter |
3890 |
# TODO: Perhaps make sure source => '*' is default? |
3891 |
my @filter_modules = grep { exists $filter->{$_->{name}} } @{$modules}; |
3892 |
|
3893 |
my $cache = Koha::Caches->get_instance(); |
3894 |
my $permissions = $cache->get_from_cache('marc_permissions', { unsafe => 1 }); |
3895 |
|
3896 |
if (!$permissions) { |
3897 |
my $query = ' |
3898 |
SELECT `marc_permissions`.*, |
3899 |
`marc_permissions_modules`.`name`, |
3900 |
`marc_permissions_modules`.`description`, |
3901 |
`marc_permissions_modules`.`specificity` |
3902 |
FROM `marc_permissions` |
3903 |
LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` |
3904 |
ORDER BY `marc_permissions_modules`.`specificity`, `id` |
3905 |
'; |
3906 |
my $sth = $dbh->prepare($query); |
3907 |
$sth->execute(); |
3908 |
while (my $perm = $sth->fetchrow_hashref) { |
3909 |
my $target = ($permissions->{$perm->{name}}->{$perm->{filter}}->{$perm->{tagfield}} //= {}); |
3910 |
foreach my $event (GetMarcPermissionEvents()) { |
3911 |
$target->{$event} = { action => $perm->{$event}, rule => $perm->{'id'} }; |
3912 |
} |
3913 |
} |
3914 |
$cache->set_in_cache('marc_permissions', $permissions); |
3915 |
} |
3916 |
|
3917 |
my $filtered_permissions = undef; |
3918 |
foreach my $module (@filter_modules) { |
3919 |
if ( |
3920 |
exists $permissions->{$module->{name}} && |
3921 |
exists $permissions->{$module->{name}}->{$filter->{$module->{name}}} |
3922 |
) { |
3923 |
# TODO: Support multiple overlapping filters/context?? |
3924 |
$filtered_permissions = $permissions->{$module->{name}}->{$filter->{$module->{name}}}; |
3925 |
last; |
3926 |
} |
3927 |
} |
3928 |
if (!$filtered_permissions) { |
3929 |
# No perms matching specific context conditions found, try wildcard value for each active context |
3930 |
foreach my $module (@filter_modules) { |
3931 |
if (exists $permissions->{$module->{name}}->{'*'}) { |
3932 |
$filtered_permissions = $permissions->{$module->{name}}->{'*'}; |
3933 |
last; |
3934 |
} |
3935 |
} |
3936 |
} |
3937 |
return $filtered_permissions; |
3938 |
} |
3939 |
|
3940 |
# TODO: Use this in GetMarcPermissions |
3941 |
=head2 GetMarcPermissionsRules |
3942 |
|
3943 |
my $rules = GetMarcPermissionsRules() |
3944 |
|
3945 |
Returns: |
3946 |
|
3947 |
=over 4 |
3948 |
|
3949 |
=item C<$rules> |
3950 |
|
3951 |
array (in list context, arrayref otherwise) of hashrefs from marc_permissions |
3952 |
table in order of module specificity and rule id. |
3953 |
|
3954 |
=back |
3955 |
|
3956 |
=cut |
3957 |
|
3958 |
sub GetMarcPermissionsRules { |
3959 |
my $dbh = C4::Context->dbh; |
3960 |
my @rules = (); |
3961 |
|
3962 |
my $query = ' |
3963 |
SELECT `marc_permissions`.`id`, |
3964 |
`marc_permissions`.`tagfield`, |
3965 |
`marc_permissions`.`filter`, |
3966 |
`marc_permissions`.`on_new`, |
3967 |
`marc_permissions`.`on_appended`, |
3968 |
`marc_permissions`.`on_removed`, |
3969 |
`marc_permissions`.`on_deleted`, |
3970 |
`marc_permissions_modules`.`name` as `module`, |
3971 |
`marc_permissions_modules`.`description`, |
3972 |
`marc_permissions_modules`.`specificity` |
3973 |
FROM `marc_permissions` |
3974 |
LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` |
3975 |
ORDER BY `marc_permissions_modules`.`specificity`, `id` |
3976 |
'; |
3977 |
my $sth = $dbh->prepare($query); |
3978 |
$sth->execute(); |
3979 |
while ( my $row = $sth->fetchrow_hashref ) { |
3980 |
push(@rules, $row); |
3981 |
} |
3982 |
|
3983 |
return wantarray ? @rules : \@rules; |
3984 |
} |
3985 |
|
3986 |
=head2 GetMarcPermissionsModules |
3987 |
|
3988 |
my $modules = GetMarcPermissionsModules() |
3989 |
|
3990 |
Returns: |
3991 |
|
3992 |
=over 4 |
3993 |
|
3994 |
=item C<$modules> |
3995 |
|
3996 |
array (in list context, arrayref otherwise) of hashrefs from |
3997 |
marc_permissions_modules table in order of specificity. |
3998 |
|
3999 |
=back |
4000 |
|
4001 |
=cut |
4002 |
|
4003 |
sub GetMarcPermissionsModules { |
4004 |
my $dbh = C4::Context->dbh; |
4005 |
my @modules = (); |
4006 |
|
4007 |
my $query = ' |
4008 |
SELECT * |
4009 |
FROM `marc_permissions_modules` |
4010 |
ORDER BY `specificity` DESC |
4011 |
'; |
4012 |
my $sth = $dbh->prepare($query); |
4013 |
$sth->execute(); |
4014 |
while ( my $row = $sth->fetchrow_hashref ) { |
4015 |
push(@modules, $row); |
4016 |
} |
4017 |
|
4018 |
return wantarray ? @modules : \@modules; |
4019 |
} |
4020 |
|
4021 |
sub GetMarcPermissionEvents { |
4022 |
return ('on_new', 'on_appended', 'on_removed', 'on_deleted'); |
4023 |
} |
4024 |
|
4025 |
=head2 ModMarcPermissionsRule |
4026 |
|
4027 |
my $success = ModMarcPermissionsRule($id, $fields) |
4028 |
|
4029 |
Modifies rule in the marc_permissions table. |
4030 |
|
4031 |
=over 4 |
4032 |
|
4033 |
=item C<$id> |
4034 |
|
4035 |
rule id to modify |
4036 |
|
4037 |
=item C<$fields> |
4038 |
|
4039 |
hashref defining the table fields |
4040 |
|
4041 |
* tagfield - required |
4042 |
* module - required |
4043 |
* filter - required |
4044 |
* on_new - required |
4045 |
* on_appended - required |
4046 |
* on_removed - required |
4047 |
* on_deleted - required |
4048 |
|
4049 |
=back |
4050 |
|
4051 |
Returns: |
4052 |
|
4053 |
=over 4 |
4054 |
|
4055 |
=item C<$success> |
4056 |
|
4057 |
undef if an error occurs, otherwise true. |
4058 |
|
4059 |
=back |
3600 |
|
4060 |
|
|
|
4061 |
=cut |
4062 |
|
4063 |
sub ModMarcPermissionsRule { |
4064 |
my ($id, $f) = @_; |
4065 |
my $dbh = C4::Context->dbh; |
4066 |
|
4067 |
my $query = ' |
4068 |
UPDATE `marc_permissions` |
4069 |
SET |
4070 |
tagfield = ?, |
4071 |
module = ?, |
4072 |
filter = ?, |
4073 |
on_new = ?, |
4074 |
on_appended = ?, |
4075 |
on_removed = ?, |
4076 |
on_deleted = ? |
4077 |
WHERE |
4078 |
id = ? |
4079 |
'; |
4080 |
my $sth = $dbh->prepare($query); |
4081 |
my $result = $sth->execute ( |
4082 |
$f->{tagfield}, |
4083 |
$f->{module}, |
4084 |
$f->{filter}, |
4085 |
$f->{on_new}, |
4086 |
$f->{on_appended}, |
4087 |
$f->{on_removed}, |
4088 |
$f->{on_deleted}, |
4089 |
$id |
4090 |
); |
4091 |
ClearMarcPermissionsRulesCache(); |
4092 |
return $result; |
4093 |
} |
4094 |
|
4095 |
sub ClearMarcPermissionsRulesCache { |
4096 |
my $cache = Koha::Caches->get_instance(); |
4097 |
$cache->clear_from_cache('marc_permissions'); |
4098 |
} |
4099 |
|
4100 |
=head2 AddMarcPermissionsRule |
4101 |
|
4102 |
my $success = AddMarcPermissionsRule($fields) |
4103 |
|
4104 |
Add rule to the marc_permissions table. |
4105 |
|
4106 |
=over 4 |
4107 |
|
4108 |
=item C<$fields> |
4109 |
|
4110 |
hashref defining the table fields |
4111 |
|
4112 |
tagfield - required |
4113 |
module - required |
4114 |
filter - required |
4115 |
on_new - required |
4116 |
on_appended - required |
4117 |
on_removed - required |
4118 |
on_deleted - required |
4119 |
|
4120 |
=back |
4121 |
|
4122 |
Returns: |
4123 |
|
4124 |
=over 4 |
4125 |
|
4126 |
=item C<$success> |
4127 |
|
4128 |
undef if an error occurs, otherwise true. |
4129 |
|
4130 |
=back |
4131 |
|
4132 |
=cut |
4133 |
|
4134 |
sub AddMarcPermissionsRule { |
4135 |
my $f = shift; |
4136 |
my $dbh = C4::Context->dbh; |
4137 |
my $query = ' |
4138 |
INSERT INTO `marc_permissions` |
4139 |
( |
4140 |
tagfield, |
4141 |
module, |
4142 |
filter, |
4143 |
on_new, |
4144 |
on_appended, |
4145 |
on_removed, |
4146 |
on_deleted |
4147 |
) |
4148 |
VALUES (?, ?, ?, ?, ?, ?, ?) |
4149 |
'; |
4150 |
my $sth = $dbh->prepare($query); |
4151 |
my $result = $sth->execute ( |
4152 |
$f->{tagfield}, |
4153 |
$f->{module}, |
4154 |
$f->{filter}, |
4155 |
$f->{on_new}, |
4156 |
$f->{on_appended}, |
4157 |
$f->{on_removed}, |
4158 |
$f->{on_deleted} |
4159 |
); |
4160 |
ClearMarcPermissionsRulesCache(); |
4161 |
return $result; |
4162 |
} |
4163 |
|
4164 |
=head2 DelMarcPermissionsRule |
4165 |
|
4166 |
my $success = DelMarcPermissionsRule($id) |
4167 |
|
4168 |
Deletes rule from the marc_permissions table. |
4169 |
|
4170 |
=over 4 |
4171 |
|
4172 |
=item C<$id> |
4173 |
|
4174 |
rule id to delete |
4175 |
|
4176 |
=back |
4177 |
|
4178 |
Returns: |
4179 |
|
4180 |
=over 4 |
4181 |
|
4182 |
=item C<$success> |
4183 |
|
4184 |
undef if an error occurs, otherwise true. |
4185 |
|
4186 |
=back |
4187 |
|
4188 |
=cut |
4189 |
|
4190 |
sub DelMarcPermissionsRule { |
4191 |
my $id = shift; |
4192 |
my $dbh = C4::Context->dbh; |
4193 |
my $query = ' |
4194 |
DELETE FROM `marc_permissions` |
4195 |
WHERE |
4196 |
id = ? |
4197 |
'; |
4198 |
my $sth = $dbh->prepare($query); |
4199 |
my $result = $sth->execute($id); |
4200 |
ClearMarcPermissionsRulesCache(); |
4201 |
return $result; |
4202 |
} |
4203 |
1; |
3601 |
|
4204 |
|
3602 |
__END__ |
4205 |
__END__ |
3603 |
|
4206 |
|