|
Line 0
Link Here
|
| 0 |
- |
1 |
package Koha::Object::ColumnSet; |
|
|
2 |
|
| 3 |
# This file is part of Koha. |
| 4 |
# |
| 5 |
# Koha is free software; you can redistribute it and/or modify it |
| 6 |
# under the terms of the GNU General Public License as published by |
| 7 |
# the Free Software Foundation; either version 3 of the License, or |
| 8 |
# (at your option) any later version. |
| 9 |
# |
| 10 |
# Koha is distributed in the hope that it will be useful, but |
| 11 |
# WITHOUT ANY WARRANTY; without even the implied warranty of |
| 12 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 13 |
# GNU General Public License for more details. |
| 14 |
# |
| 15 |
# You should have received a copy of the GNU General Public License |
| 16 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
| 17 |
|
| 18 |
use Modern::Perl; |
| 19 |
use Carp (); |
| 20 |
use Data::Dumper (); |
| 21 |
|
| 22 |
use Koha::Logger (); |
| 23 |
|
| 24 |
=head1 NAME |
| 25 |
|
| 26 |
Koha::Object::ColumnSet |
| 27 |
|
| 28 |
=head1 API |
| 29 |
|
| 30 |
=head2 Class Methods |
| 31 |
|
| 32 |
=head3 new |
| 33 |
|
| 34 |
Constructor. |
| 35 |
|
| 36 |
=cut |
| 37 |
|
| 38 |
sub new { |
| 39 |
my ( $class, $params ) = @_; # parameter hash keys: rs, name |
| 40 |
my $self = bless( $params, $class ); |
| 41 |
$self->_get_column_set; |
| 42 |
return $self; |
| 43 |
} |
| 44 |
|
| 45 |
sub _get_column_set { |
| 46 |
my ( $self ) = @_; |
| 47 |
my $rs = $self->{rs} or return; |
| 48 |
my $name = $self->{name} or return; |
| 49 |
|
| 50 |
# If the schema does not contain this sub, _list will not be set. |
| 51 |
# If the sub exists but the name of the set is not found, _list will be undef. |
| 52 |
# See further apply_filter. |
| 53 |
if( $rs->can('get_column_set') ) { |
| 54 |
$self->{_list} = $rs->get_column_set($name); |
| 55 |
} |
| 56 |
} |
| 57 |
|
| 58 |
=head3 apply_filter |
| 59 |
|
| 60 |
$set->apply_filter({ input => $input, deny_mode => $deny_mode, log_level => $log_level, dump => $dump }); |
| 61 |
|
| 62 |
Apply column set filter to $input or the passed resultset (see new). |
| 63 |
$deny_mode turns the column set into a deny list. |
| 64 |
Diagnostics and logging via $dump and $log_level. |
| 65 |
|
| 66 |
NOTE: Returns all data if schema does not support get_column_set yet. Returns undef if set not found. |
| 67 |
|
| 68 |
=cut |
| 69 |
|
| 70 |
sub apply_filter { |
| 71 |
my ( $self, $params ) = @_; |
| 72 |
my $data = $params->{input} // { $self->{rs}->get_columns }; |
| 73 |
my $log_level = $params->{log_level}; |
| 74 |
return $data if !exists( $self->{_list} ); # no get_column_set in schema, just return all data |
| 75 |
return unless $self->{_list}; # no results if the specific column set is not found |
| 76 |
|
| 77 |
my ( $result, $blocked ); |
| 78 |
unless( $params->{deny_mode} ) { # as allow list |
| 79 |
$result = { map { exists $data->{$_} ? ($_, $data->{$_}) : () } @{$self->{_list}} }; |
| 80 |
} else { # as deny list |
| 81 |
$result = { %$data }; |
| 82 |
map { delete $result->{$_} } @{$self->{_list}}; |
| 83 |
} |
| 84 |
|
| 85 |
# Handle optional diagnostics, logging |
| 86 |
if( $params->{dump} || $log_level ) { |
| 87 |
$blocked = { map { !exists $result->{$_} ? ($_, $data->{$_}) : () } keys %$data }; |
| 88 |
map { $params->{dump}->{$_} = $blocked->{$_} } keys %$blocked if $params->{dump}; |
| 89 |
if( $log_level && keys %$blocked ) { |
| 90 |
my $stack = Carp::longmess; $stack =~ s/\n/, /g; |
| 91 |
my $diag = Data::Dumper->new([ $stack, $blocked ])->Indent(0)->Dump; |
| 92 |
Koha::Logger->get->$log_level( $diag ); |
| 93 |
} |
| 94 |
} |
| 95 |
|
| 96 |
return $result; |
| 97 |
} |
| 98 |
|
| 99 |
=head3 list_columns |
| 100 |
|
| 101 |
$set->list_columns |
| 102 |
|
| 103 |
=cut |
| 104 |
|
| 105 |
sub list_columns { |
| 106 |
my ( $self ) = @_; |
| 107 |
return [ sort @{$self->{_list}} ] if $self->{_list}; |
| 108 |
} |
| 109 |
|
| 110 |
1; |