File Coverage

blib/lib/Test2/Util/Ref.pm
Criterion Covered Total %
statement 33 33 100.0
branch 17 18 94.4
condition 5 7 71.4
subroutine 6 6 100.0
pod 2 2 100.0
total 63 66 95.4


line stmt bran cond sub pod time code
1             package Test2::Util::Ref;
2 170     170   1176 use strict;
  170         349  
  170         5056  
3 170     170   889 use warnings;
  170         349  
  170         7115  
4              
5             our $VERSION = '0.000156';
6              
7 170     170   1035 use Scalar::Util qw/reftype blessed refaddr/;
  170         372  
  170         14089  
8              
9             our @EXPORT_OK = qw/rtype render_ref/;
10 170     170   1333 use base 'Exporter';
  170         412  
  170         73872  
11              
12             sub rtype {
13 26935     26935 1 40871 my ($thing) = @_;
14 26935 100       45654 return '' unless defined $thing;
15              
16 26933         41338 my $rf = ref $thing;
17 26933         49905 my $rt = reftype $thing;
18              
19 26933 100 66     90473 return '' unless $rf || $rt;
20 6205 100       18602 return 'REGEXP' if $rf =~ m/Regex/i;
21 5940 50       12115 return 'REGEXP' if $rt =~ m/Regex/i;
22 5940   50     16393 return $rt || '';
23             }
24              
25             sub render_ref {
26 17245     17245 1 28654 my ($in) = @_;
27              
28 17245 100       32077 return 'undef' unless defined($in);
29              
30 16943         29280 my $type = rtype($in);
31 16943 100       47524 return "$in" unless $type;
32              
33             # Look past overloading
34 4980   100     16625 my $class = blessed($in) || '';
35              
36 4980         19587 my $it = sprintf('0x%x', refaddr($in));
37 4980         10716 my $ref = "$type($it)";
38              
39 4980 100       12057 return $ref unless $class;
40              
41 2848         5350 my $out = "$class=$ref";
42 2848 100       6629 if ($class =~ m/bool/i) {
43 8 100       29 my $bool = $in ? 'TRUE' : 'FALSE';
44 8         93 return "<$bool: $out>";
45             }
46 2840         7327 return $out;
47             }
48              
49             1;
50              
51             __END__