package Log::Message::Structured::Component::AttributesFilter;
use strict;
use warnings;
use MooseX::Role::Parameterized;
use namespace::autoclean;
use Moose::Util::TypeConstraints;
use MooseX::Types::Structured qw(Dict Optional);
use List::MoreUtils qw(notall any);
parameter filter => (
isa => enum([qw(in out)]),
default => sub { 'in' },
);
parameter type => (
isa => enum([qw(public private)]),
required => 0,
);
parameter name => (
isa => 'RegexpRef|CodeRef',
required => 0,
);
parameter value => (
isa => 'RegexpRef|CodeRef',
required => 0,
);
parameter custom => (
isa => 'CodeRef',
required => 0,
);
role {
my ($p) = @_;
my $in = $p->filter eq 'in';
my @functions = $in ? sub { 1 } : sub { 0 } ;
if (defined( my $r = $p->type)) {
my $r = $p->type eq 'public' ? qr/^[^_]/ : qr/^_/;
push @functions,
sub { $_[0]->name =~ /$r/ }
}
if (defined(my $cond = $p->name)) {
my $f = ref($cond) eq 'CODE'
? $cond : sub { /$cond/ };
push @functions,
sub { local $_ = $_[0]->name; $f->() }
}
if (defined (my $cond = $p->value)) {
my $f = ref($cond) eq 'CODE'
? $cond : sub { /$cond/ };
push @functions,
sub { local $_ = $_[0]->get_value($_[1]); $f->() }
}
if (defined (my $custom = $p->custom)) {
push @functions, $custom;
}
my $filter = $in
? # filtering in
sub {
my ($self, $hash) = @_;
delete @{$hash}{
map { $_->name }
grep { my $attr = $_; notall { $_->($attr, $self) } @functions
} $self->meta->get_all_attributes
};
$hash;
}
: # filtering out
sub {
my ($self, $hash) = @_;
delete @{$hash}{
map { $_->name }
grep { my $attr = $_; any { $_->($attr, $self) } @functions
} $self->meta->get_all_attributes
};
$hash;
};
around 'as_hash' => sub {
my $orig = shift;
my $self = shift;
my $r = $filter->($self, $self->$orig(@_));
$r;
}
};
1;
=pod
=head1 NAME
Log::Message::Structured::Component::AttributesFilter
=head1 SYNOPSIS
package MyLogEvent;
use Moose;
use namespace::autoclean;
with ('Log::Message::Structured',
'Log::Message::Structured::Stringify::AsJSON',
'Log::Message::Structured::Component::AttributesFilter' => {
filter => 'out',
name => qr /^foo/,
});
has [qw/ foo bar /] => ( is => 'ro', required => 1 );
... elsewhere ...
use aliased 'My::Log::Event';
$logger->log(Event->new( foo => "ONE MILLION", bar => "ONE BILLION" ));
# Logs:
{"__CLASS__":"MyLogEvent","foo":"ONE MILLION"}
# note that bar is not included in the structure
=head1 DESCRIPTION
Augments the C<as_string> method provided by L<Log::Message::Structured> as a
parameterised Moose role.
=head1 PARAMETERS
=head1 filter
Enum : in, out. Specifies if the other criterias are to be used to filter in or out. Defaults to 'in'.
=head2 type
Enum : public, private. Filters on the attribute type
=head2 name
a RegexpRef or a CodeRef. Used to filter on the attribute name. The CodeRef will recieve the attribute's name in $_
=head2 value
a RegexpRef or a CodeRef. Used to filter on the attribute value. The CodeRef will recieve the attribute's value in $_
=head2 custom
a CodeRef. Used to do custom filtering. Will recieve the L<Class::MOP::Attribute> as first argument, and C<$self> as second argument.
=head1 AUTHOR AND COPYRIGHT
Damien Krotkine (dams) C<< <dams@cpan.org> >>.
=head1 LICENSE
Licensed under the same terms as perl itself.
=cut