From d0e6221c4479d9f0f2411d3e8d0ee4da2ed3c20d Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Tue, 26 Apr 2016 11:54:00 +0100
Subject: mostly working

---
 lib/ACME/AutoRedact.pm |  91 ++++++++++++++++++++++++++++++++++++++++++
 t/basic.t              | 105 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 196 insertions(+)

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;
diff --git a/t/basic.t b/t/basic.t
index e69de29..712afe4 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -0,0 +1,105 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most;
+use ACME::AutoRedact;
+
+sub test_redact {
+    my ($o,$redacted,$revealed) = @_;
+
+    cmp_deeply(
+        $o,
+        str($revealed),
+        'should stringify to the original value',
+    );
+
+    {
+        ACME::AutoRedact->redact;
+        cmp_deeply(
+            $o,
+            str($redacted),
+            'inside a ->redact, it should stringify to asterisks',
+        );
+    }
+
+    cmp_deeply(
+        $o,
+        str($revealed),
+        'outside the ->redact, it should stringify to the value again',
+    );
+}
+
+sub test_reveal {
+    my ($o,$redacted,$revealed) = @_;
+
+    cmp_deeply(
+        $o,
+        str($redacted),
+        'should stringify to asterisks',
+    );
+
+    {
+        ACME::AutoRedact->reveal;
+        cmp_deeply(
+            $o,
+            str($revealed),
+            'inside a ->reveal, it should stringify to the original value',
+        );
+    }
+
+    cmp_deeply(
+        $o,
+        str($redacted),
+        'outside the ->revealed, it should stringify to asterisks again',
+    );
+}
+
+sub simulate_redact { return '*' x length($_[0]) }
+
+subtest 'just the object' => sub {
+    my $value = 'a password';
+    my $o = ACME::AutoRedact->new({
+        value => $value,
+    });
+    test_redact($o,simulate_redact($value),$value);
+};
+
+subtest 'redact by default' => sub {
+    my $value = 'another password';
+    my $o = ACME::AutoRedact->new({
+        value => $value,
+        default_behaviour => 'redact',
+    });
+    test_reveal($o,simulate_redact($value),$value);
+};
+
+subtest 'concatenation' => sub {
+    my $value = 'some secret';
+    my $o = ACME::AutoRedact->new($value);
+    my $prefix = 'embedding ';
+    my $suffix = ' in a bigger string';
+
+    my $string = "$prefix$o$suffix";
+
+    test_redact(
+        $string,
+        $prefix.simulate_redact($value).$suffix,
+        "$prefix$value$suffix",
+    );
+};
+
+subtest 'sprintf' => sub {
+    my $value = 'some secret';
+    my $o = ACME::AutoRedact->new($value);
+    my $pattern = 'embedding %s in a bigger string';
+
+    my $string = sprintf $pattern,$o;
+
+    test_redact(
+        $string,
+        sprintf($pattern,simulate_redact($value)),
+        sprintf($pattern,$value),
+    );
+};
+
+done_testing;
-- 
cgit v1.2.3