File Coverage

blib/lib/Data/Clean/ForJSON/Pregen.pm
Criterion Covered Total %
statement 74 131 56.4
branch 49 88 55.6
condition 8 15 53.3
subroutine 10 10 100.0
pod 2 2 100.0
total 143 246 58.1


line stmt bran cond sub pod time code
1             package Data::Clean::ForJSON::Pregen;
2              
3             our $DATE = '2019-09-08'; # DATE
4             our $VERSION = '0.001'; # VERSION
5              
6 1     1   54731 use 5.010001;
  1         10  
7 1     1   13 use strict;
  1         3  
  1         20  
8 1     1   4 use warnings;
  1         1  
  1         32  
9              
10 1     1   5 use Exporter qw(import);
  1         1  
  1         950  
11             our @EXPORT_OK = qw(
12             clean_for_json_in_place
13             clone_and_clean_for_json
14             );
15              
16             sub _clone {
17 3 50   3   5 if (eval { require Data::Clone; 1 }) {
  3         383  
  3         1021  
18 3         17 Data::Clone::clone(@_);
19             } else {
20 0         0 require Clone::PP;
21 0         0 Clone::PP::clone(@_);
22             }
23             }
24              
25             # generated with Data::Clean version 0.505, Data::Clean::ForJSON version 0.394
26             sub clean_for_json_in_place {
27 3     3   5 state $sub_unbless = sub { my $ref = shift;
28            
29 3         5 my $r = ref($ref);
30             # not a reference
31 3 50       5 return $ref unless $r;
32            
33             # return if not a blessed ref
34 3 50       22 my ($r2, $r3) = "$ref" =~ /(.+)=(.+?)\(/
35             or return $ref;
36            
37 3 50       7 if ($r3 eq 'HASH') {
    0          
    0          
38 3         11 return { %$ref };
39             } elsif ($r3 eq 'ARRAY') {
40 0         0 return [ @$ref ];
41             } elsif ($r3 eq 'SCALAR') {
42 0         0 return \( my $copy = ${$ref} );
  0         0  
43             } else {
44 0         0 die "Can't handle $ref";
45             }
46 4     4 1 3092 };
47 4         7 my $data = shift;
48 4         5 state %refs;
49 4         5 state $ctr_circ;
50 4         5 state $process_array;
51 4         5 state $process_hash;
52 4 100   3   10 if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { my $ref=ref($e);
  3         6  
  3         6  
  1         2  
53 1 0 33     23 if ($ref && $refs{ $e }++) { if (++$ctr_circ <= 1) { $e = _clone($e); redo } else { $e = 'CIRCULAR'; $ref = '' } }
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
    50          
    50          
    50          
54 0         0 elsif ($ref eq 'DateTime') { $e = $e->epoch; $ref = ref($e) }
  0         0  
55 0         0 elsif ($ref eq 'Math::BigInt') { $e = $e->bstr; $ref = ref($e) }
  0         0  
56 0         0 elsif ($ref eq 'Regexp') { $e = "$e"; $ref = "" }
  0         0  
57 0         0 elsif ($ref eq 'SCALAR') { $e = ${ $e }; $ref = ref($e) }
  0         0  
  0         0  
58 0         0 elsif ($ref eq 'Time::Moment') { $e = $e->epoch; $ref = ref($e) }
  0         0  
59 0         0 elsif ($ref eq 'version') { $e = "$e"; $ref = "" }
  0         0  
60 1         4 elsif (Scalar::Util::blessed($e)) { $e = $sub_unbless->($e); $ref = ref($e) }
  1         3  
61 1   50     4 my $reftype=Scalar::Util::reftype($e)//"";
62 1 50       5 if ($reftype eq "ARRAY") { $process_array->($e) }
  0 50       0  
    0          
63 1         2 elsif ($reftype eq "HASH") { $process_hash->($e) }
64 0         0 elsif ($ref) { $e = $ref; $ref = "" }
  0         0  
65 1         4 } } }
66 4 100   5   7 if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { my $ref=ref($h->{$k});
  5         8  
  5         14  
  7         15  
67 7 50 66     58 if ($ref && $refs{ $h->{$k} }++) { if (++$ctr_circ <= 1) { $h->{$k} = _clone($h->{$k}); redo } else { $h->{$k} = 'CIRCULAR'; $ref = '' } }
  1 100       3  
  1 50       2  
  1 50       2  
  0 50       0  
  0 100       0  
    50          
    100          
    100          
68 0         0 elsif ($ref eq 'DateTime') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
  0         0  
69 0         0 elsif ($ref eq 'Math::BigInt') { $h->{$k} = $h->{$k}->bstr; $ref = ref($h->{$k}) }
  0         0  
70 0         0 elsif ($ref eq 'Regexp') { $h->{$k} = "$h->{$k}"; $ref = "" }
  0         0  
71 1         2 elsif ($ref eq 'SCALAR') { $h->{$k} = ${ $h->{$k} }; $ref = ref($h->{$k}) }
  1         2  
  1         2  
72 0         0 elsif ($ref eq 'Time::Moment') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
  0         0  
73 1         4 elsif ($ref eq 'version') { $h->{$k} = "$h->{$k}"; $ref = "" }
  1         2  
74 1         3 elsif (Scalar::Util::blessed($h->{$k})) { $h->{$k} = $sub_unbless->($h->{$k}); $ref = ref($h->{$k}) }
  1         3  
75 6   100     20 my $reftype=Scalar::Util::reftype($h->{$k})//"";
76 6 100       18 if ($reftype eq "ARRAY") { $process_array->($h->{$k}) }
  2 100       3  
    100          
77 1         3 elsif ($reftype eq "HASH") { $process_hash->($h->{$k}) }
78 1         2 elsif ($ref) { $h->{$k} = $ref; $ref = "" }
  1         2  
79 1         4 } } }
80 4         10 %refs = (); $ctr_circ=0;
  4         6  
81 4         9 for ($data) { my $ref=ref($_);
  4         7  
82 4 0 33     41 if ($ref && $refs{ $_ }++) { if (++$ctr_circ <= 1) { $_ = _clone($_); redo } else { $_ = 'CIRCULAR'; $ref = '' } }
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
  0 50       0  
    50          
    50          
    100          
83 0         0 elsif ($ref eq 'DateTime') { $_ = $_->epoch; $ref = ref($_) }
  0         0  
84 0         0 elsif ($ref eq 'Math::BigInt') { $_ = $_->bstr; $ref = ref($_) }
  0         0  
85 0         0 elsif ($ref eq 'Regexp') { $_ = "$_"; $ref = "" }
  0         0  
86 0         0 elsif ($ref eq 'SCALAR') { $_ = ${ $_ }; $ref = ref($_) }
  0         0  
  0         0  
87 0         0 elsif ($ref eq 'Time::Moment') { $_ = $_->epoch; $ref = ref($_) }
  0         0  
88 0         0 elsif ($ref eq 'version') { $_ = "$_"; $ref = "" }
  0         0  
89 1         2 elsif (Scalar::Util::blessed($_)) { $_ = $sub_unbless->($_); $ref = ref($_) }
  1         2  
90 4   50     12 my $reftype=Scalar::Util::reftype($_)//"";
91 4 100       10 if ($reftype eq "ARRAY") { $process_array->($_) }
  1 50       2  
    0          
92 3         6 elsif ($reftype eq "HASH") { $process_hash->($_) }
93 0         0 elsif ($ref) { $_ = $ref; $ref = "" }
  0         0  
94             }
95             $data
96 4         10 }
97              
98              
99             sub clone_and_clean_for_json {
100 2     2 1 2421 my $data = _clone(shift);
101 2         5 clean_for_json_in_place($data);
102             }
103              
104             1;
105             # ABSTRACT: Clean data so it is safe to output to JSON
106              
107             __END__