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 (ref $args{replacement_callbacks} eq 'HASH') {
        $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) = @_;
    $recurse_count ||= 0;
    
    no warnings 'recursion'; # we're checking ourselves.

    if ($recurse_count++ > $self->{recurse_limit}) {
        warn "Data exceeding $self->{recurse_limit} levels";
        return;
    }

    if (ref $data ne 'HASH') {
        croak('censor expects a hashref');
    }
    
    my $censored = 0;
    for my $key (keys %$data) {
        if (ref $data->{$key} eq 'HASH') {
            $censored += $self->censor($data->{$key}, $recurse_count);
        } elsif (