Data-Censor
view release on metacpan or search on metacpan
lib/Data/Censor.pm view on Meta::CPAN
# Specify which fields to censor:
sensitive_fields => [ qw(card_number password) ],
# Specify text to replace their values with:
replacement => '(Sensitive data hidden)',
# Or specify callbacks for each field name which return the "censored"
# value - in this case, masking a card number (PAN) to show only the
# last four digits:
replacement_callbacks => {
card_number => sub {
my $pan = shift;
return "x" x (length($pan) - 4) . substr($pan, -4, 4);
},
},
);
# Censor the data in-place (changes the data structure, returns the number
# of keys censored)
my $censor_count = $censor->censor(\%data);
# Alternate non-OO interface, using default settings and returning a cloned
# version of the data after censoring:
my $censored_data = Data::Censor->clone_and_censor(\%data);
=head1 new (CONSTRUCTOR)
Accepts the following arguments:
=over
=item sensitive_fields
Either an arrayref of sensitive fields, checked for equality, or a regex to test
against each key to see if it's considered sensitive.
=item replacement
The string to replace each value with. Any censoring callback provided in
C<replacement_callbacks> which matches this key will take precedence over this
straightforward value.
=item replacement_callbacks
A hashref of key => sub {...}, where each key is a column name to match, and the
coderef takes the uncensored value and returns the censored value, letting you
for instance mask a card number but leave the last 4 digits visible.
If you provide both C<replacement> and C<replacement_callbacks>, any callback
defined which matches the key being considered takes precedence.
=back
=cut
sub new {
my $class = shift;
my %args = @_;
my $self = bless {} => $class;
if ( ref $args{sensitive_fields} eq 'Regexp' ) {
$self->{censor_regex} = $args{sensitive_fields};
} elsif ( ref $args{sensitive_fields} eq 'ARRAY' ) {
$self->{is_sensitive_field} = {
map { $_ => 1 } @{ $args{sensitive_fields} }
};
} else {
$self->{is_sensitive_field} = {
map { $_ => 1 } qw(
pass password old_password secret
private_key cardnum card_number pan
cvv cvv2 ccv
)
};
}
if ( is_hashref $args{replacement_callbacks} ) {
$self->{replacement_callbacks} = $args{replacement_callbacks};
}
if ( exists $args{replacement} ) {
$self->{replacement} = $args{replacement};
} else {
$self->{replacement} = 'Hidden (looks potentially sensitive)';
}
$self->{recurse_limit} = $args{recurse_limit} || 100;
return $self;
}
=head1 METHODS
=head2 censor
Given a data structure (hashref), clones it and returns the cloned version after
censoring potentially sensitive data within.
=cut
sub censor {
my ( $self, $data, $recurse_count, $visited ) = @_;
$recurse_count ||= 0;
$visited ||= {};
no warnings 'recursion'; # we're checking ourselves.
if ( $recurse_count++ > $self->{recurse_limit} ) {
warn "Data exceeding $self->{recurse_limit} levels";
return;
}
croak('censor expects a hashref') unless is_hashref $data;
my $censored = 0;
for my $key ( keys %$data ) {
if ( is_hashref $data->{$key} ) {
$censored
+= $self->censor( $data->{$key}, $recurse_count, $visited )
( run in 0.265 second using v1.01-cache-2.11-cpan-eab888a1d7d )