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