diff options
Diffstat (limited to 'lib/ACME/AutoRedact.pm')
-rw-r--r-- | lib/ACME/AutoRedact.pm | 91 |
1 files changed, 91 insertions, 0 deletions
diff --git a/lib/ACME/AutoRedact.pm b/lib/ACME/AutoRedact.pm index e69de29..0b85712 100644 --- a/lib/ACME/AutoRedact.pm +++ b/lib/ACME/AutoRedact.pm @@ -0,0 +1,91 @@ +package ACME::AutoRedact; +use strict; +use warnings; +# VERSION +use Scope::Upper qw(localize :words); +use Scalar::Util qw(blessed); + +# ABSTRACT: string-like object that can redact its value out of derived strings + +use overload + q{""} => \&stringify, + q{.} => \&concat, + fallback => 1, + ; + +sub _build__redacted { + my ($self) = @_; + return '*' x length($self->{value}); +} + +sub new { + my ($class,@args) = @_; + + my $self; + if (@args==1 and not ref $args[0]) { + $self = { value => $args[0] }; + } + elsif (@args==1) { + $self = $args[0]; + } + else { + $self = { @args }; + } + bless $self,$class; + $self->{_redacted} //= $self->_build__redacted; + return $self; +} + +our $requested_behaviour; + +sub redact { + localize *requested_behaviour, \'redact', UP; +} + +sub reveal { + localize *requested_behaviour, \'reveal', UP; +} + +sub stringify { + my ($self) = @_; + + my $behaviour = $requested_behaviour // $self->{default_behaviour} // 'reveal'; + + if ($behaviour eq 'reveal') { + return $self->{value}; + } + else { + return $self->{_redacted}; + } +} + +sub concat { + my ($self,$other,$swap) = @_; + + my %new; + if ((blessed($other)//'') eq __PACKAGE__) { + $new{value} = $swap + ? $other->{value} . $self->{value} + : $self->{value} . $other->{value}; + $new{_redacted} = $swap + ? $other->{_redacted} . $self->{_redacted} + : $self->{_redacted} . $other->{_redacted}; + + $new{default_behaviour} = $swap + ? $other->{default_behaviour} + : $self->{default_behaviour}; + } + else { + $new{value} = $swap + ? "$other" . $self->{value} + : $self->{value} . "$other"; + $new{_redacted} = $swap + ? "$other" . $self->{_redacted} + : $self->{_redacted} . "$other"; + $new{default_behaviour} = $self->{default_behaviour}; + } + + return ref($self)->new(\%new); +} + +1; |