1package Test2::Util::Ref;
2use strict;
3use warnings;
4
5our $VERSION = '0.000143';
6
7use Scalar::Util qw/reftype blessed refaddr/;
8
9our @EXPORT_OK = qw/rtype render_ref/;
10use base 'Exporter';
11
12sub rtype {
13    my ($thing) = @_;
14    return '' unless defined $thing;
15
16    my $rf = ref $thing;
17    my $rt = reftype $thing;
18
19    return '' unless $rf || $rt;
20    return 'REGEXP' if $rf =~ m/Regex/i;
21    return 'REGEXP' if $rt =~ m/Regex/i;
22    return $rt || '';
23}
24
25sub render_ref {
26    my ($in) = @_;
27
28    return 'undef' unless defined($in);
29
30    my $type = rtype($in);
31    return "$in" unless $type;
32
33    # Look past overloading
34    my $class = blessed($in) || '';
35    my $it = sprintf('0x%x', refaddr($in));
36    my $ref = "$type($it)";
37
38    return $ref unless $class;
39    return "$class=$ref";
40}
41
421;
43
44__END__
45
46=pod
47
48=encoding UTF-8
49
50=head1 NAME
51
52Test2::Util::Ref - Tools for inspecting or manipulating references.
53
54=head1 DESCRIPTION
55
56These are used by L<Test2::Tools> to inspect, render, or manipulate references.
57
58=head1 EXPORTS
59
60All exports are optional. You must specify subs to import.
61
62=over 4
63
64=item $type = rtype($ref)
65
66A normalization between C<Scalar::Util::reftype()> and C<ref()>.
67
68Always returns a string.
69
70Returns C<'REGEXP'> for regex types
71
72Returns C<''> for non-refs
73
74Otherwise returns what C<Scalar::Util::reftype()> returns.
75
76=item $addr_str = render_ref($ref)
77
78Always returns a string. For unblessed references this returns something like
79C<"SCALAR(0x...)">. For blessed references it returns
80C<"My::Thing=SCALAR(0x...)">. The only difference between this and C<$add_str =
81"$thing"> is that it ignores any overloading to ensure it is always the ref
82address.
83
84=back
85
86=head1 SOURCE
87
88The source code repository for Test2-Suite can be found at
89F<https://github.com/Test-More/Test2-Suite/>.
90
91=head1 MAINTAINERS
92
93=over 4
94
95=item Chad Granum E<lt>exodist@cpan.orgE<gt>
96
97=back
98
99=head1 AUTHORS
100
101=over 4
102
103=item Chad Granum E<lt>exodist@cpan.orgE<gt>
104
105=item Kent Fredric E<lt>kentnl@cpan.orgE<gt>
106
107=back
108
109=head1 COPYRIGHT
110
111Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>.
112
113This program is free software; you can redistribute it and/or
114modify it under the same terms as Perl itself.
115
116See F<http://dev.perl.org/licenses/>
117
118=cut
119