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   1145 use strict;
  170         308  
  170         4720  
3 170     170   835 use warnings;
  170         495  
  170         6818  
4              
5             our $VERSION = '0.000155';
6              
7 170     170   992 use Scalar::Util qw/reftype blessed refaddr/;
  170         343  
  170         13608  
8              
9             our @EXPORT_OK = qw/rtype render_ref/;
10 170     170   1493 use base 'Exporter';
  170         453  
  170         71331  
11              
12             sub rtype {
13 26515     26515 1 41709 my ($thing) = @_;
14 26515 100       44953 return '' unless defined $thing;
15              
16 26513         41507 my $rf = ref $thing;
17 26513         47463 my $rt = reftype $thing;
18              
19 26513 100 66     89873 return '' unless $rf || $rt;
20 6117 100       18964 return 'REGEXP' if $rf =~ m/Regex/i;
21 5852 50       11789 return 'REGEXP' if $rt =~ m/Regex/i;
22 5852   50     16346 return $rt || '';
23             }
24              
25             sub render_ref {
26 16925     16925 1 27865 my ($in) = @_;
27              
28 16925 100       31133 return 'undef' unless defined($in);
29              
30 16623         29444 my $type = rtype($in);
31 16623 100       46596 return "$in" unless $type;
32              
33             # Look past overloading
34 4896   100     15987 my $class = blessed($in) || '';
35              
36 4896         18992 my $it = sprintf('0x%x', refaddr($in));
37 4896         10984 my $ref = "$type($it)";
38              
39 4896 100       11508 return $ref unless $class;
40              
41 2832         5306 my $out = "$class=$ref";
42 2832 100       6684 if ($class =~ m/bool/i) {
43 8 100       35 my $bool = $in ? 'TRUE' : 'FALSE';
44 8         97 return "<$bool: $out>";
45             }
46 2824         7075 return $out;
47             }
48              
49             1;
50              
51             __END__