File Coverage

blib/lib/String/Secret.pm

Criterion	Covered	Total	%
statement	34	39	87.1
branch	6	6	100.0
condition			n/a
subroutine	13	18	72.2
pod	0	12	0.0
total	53	75	70.6

package String::Secret;
use 5.008001;
use strict;
use warnings;

use Scalar::Util qw/refaddr/;

our $VERSION = "0.01";

use overload
    '""' => 'to_string',
    fallback => 1;

our $DISABLE_MASK = 0;
our $MASKED_STRING = '*' x 8;

my %SECRETS;

sub new {
    my ($class, $secret) = @_;
    my $masked = $MASKED_STRING;
    my $self = bless \$masked, $class;
    $SECRETS{refaddr($self)} = $secret;
    return $self;
}

sub from_serializable { $_[0]->new($_[1]->unwrap) }

sub unwrap { $SECRETS{refaddr($_[0])} }

sub to_serializable {
    require String::Secret::Serializable;
    String::Secret::Serializable->new(shift->unwrap);
}

sub to_string {
    return shift->unwrap if $DISABLE_MASK;
    return $MASKED_STRING;
}

# for Storable
sub STORABLE_freeze {
    my ($self, $cloning) = @_;
    return $self->unwrap if $cloning;
    return $self->to_string;
}
sub STORABLE_thaw {
    my ($self, $cloning, $masked) = @_;
    if ($cloning) {
        $SECRETS{refaddr($self)} = $masked; # $masked is unwrapped value
        return $self;
    }

    die "cannot deserialize it, should convert it as serializable by \$secret->to_serializable";
}

# for JSON modules
sub TO_JSON { shift->to_string }

# for CBOR
sub TO_CBOR { shift->to_string }

# for JSON, CBOR, Sereal, ...
sub FREEZE { shift->to_string }
sub THAW {
    die "cannot deserialize it, should convert it as serializable by \$secret->to_serializable";
}

# for Data::Clone
sub clone { shift } # immutable

sub DESTROY { delete $SECRETS{refaddr($_[0])} }

1;
__END__