File Coverage

blib/lib/Object/Util/Stringify.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	6	8	75.0
condition			n/a
subroutine	7	7	100.0
pod	2	2	100.0
total	43	45	95.5

package Object::Util::Stringify;

use strict;
use warnings;

use Scalar::Util qw(blessed refaddr);

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-09-28'; # DATE
our $DIST = 'Object-Util-Stringify'; # DIST
our $VERSION = '0.001'; # VERSION

our @EXPORT_OK = qw(
                       set_stringify
                       unset_stringify
               );

my %Overloaded_Packages;
my %Object_Strings; # key=refaddr, val=string
sub set_stringify {
    require overload;

    my ($obj, $str) = @_;

    die "First argument must be a blessed reference" unless blessed($obj);

    my $obj_pkg = ref $obj;
    $Object_Strings{ refaddr($obj) } = $str;
    $obj_pkg->overload::OVERLOAD(q("") => \&_overload_string)
        unless $Overloaded_Packages{$obj_pkg}++;

    # return the obj for convenience
    $obj;
}

sub unset_stringify {
    require overload;

    my ($obj, $str) = @_;

    die "First argument must be a blessed reference" unless blessed($obj);

    my $obj_pkg = ref $obj;
    delete $Object_Strings{ refaddr($obj) };

    # return the obj for convenience
    $obj;
}

sub _overload_string {
    my $obj = shift;
    my $key = refaddr $obj;
    exists($Object_Strings{$key}) ? $Object_Strings{$key} : $obj;
}

1;
# ABSTRACT: Utility routines related to object stringification

__END__