File Coverage

blib/lib/Config/Structured/Deserializer.pm
Criterion Covered Total %
statement 53 54 98.1
branch 7 8 87.5
condition 2 3 66.6
subroutine 15 15 100.0
pod 0 3 0.0
total 77 83 92.7


line stmt bran cond sub pod time code
1             package Config::Structured::Deserializer;
2             $Config::Structured::Deserializer::VERSION = '2.004';
3             # ABSTRACT: Deserializes perl structures, JSON or YML data, from strings or files
4              
5 11     11   90 use strict;
  11         40  
  11         373  
6 11     11   78 use warnings;
  11         40  
  11         333  
7              
8 11     11   92 use File::Basename;
  11         36  
  11         1009  
9 11     11   119 use IO::All;
  11         31  
  11         180  
10 11     11   951 use Readonly;
  11         63  
  11         710  
11              
12 11     11   7914 use JSON qw(decode_json);
  11         118596  
  11         68  
13 11     11   6197 use YAML::XS;
  11         28312  
  11         721  
14              
15 11     11   5881 use Syntax::Keyword::Try;
  11         24194  
  11         68  
16              
17 11     11   6453 use experimental qw(signatures);
  11         40178  
  11         312  
18              
19             Readonly::Hash my %FILE_TYPES => (
20             yml => 'yaml',
21             yaml => 'yaml',
22             json => 'json',
23             );
24             Readonly::Scalar my $DEFAULT_DECODER => q{perl};
25              
26 18     18 0 27 sub decoders() {
  18         27  
27             return (
28             yaml => sub {
29 21     21   1436 Load(shift());
30             },
31             json => sub {
32 9     9   226 decode_json(shift());
33             },
34             perl => sub {
35 17     17   1132 eval(shift());
36             },
37 18         174 );
38             }
39              
40 18     18 0 32 sub is_filename($str) {
  18         31  
  18         31  
41 18 100       79 return 0 if ($str =~ /\n/);
42 8         256 return (-f $str);
43             }
44              
45 74     74 0 139 sub decode ($class, $v) {
  74         132  
  74         120  
  74         113  
46 74 100       1612 return $v if (ref($v) eq 'HASH');
47              
48 18         68 my %decoders = decoders();
49 18         44 my $hint = $DEFAULT_DECODER;
50 18 100       49 if (is_filename($v)) {
51 8         78 my ($fn, $dirs, $suffix) = fileparse($v, keys(%FILE_TYPES));
52 8 50       776 $hint = $FILE_TYPES{$suffix} if (defined($suffix));
53 8         101 $v = io->file($v)->slurp;
54             }
55 18         23740 do {
56 29   66     226 my $n = $hint // (keys(%decoders))[0];
57 29         76 my $decoder = delete($decoders{$n});
58             try {
59             my $structure = $decoder->($v);
60             return $decoder->($v) if (ref($structure) eq 'HASH');
61 29         75 } catch {
62             # ignore any errors and try the next decoder, or die out at the bottom
63             };
64             } while (($hint) = keys(%decoders));
65 0           die("Config::Structured was unable to decode input");
66             }
67              
68             1;
69              
70             __END__
71              
72             =pod
73              
74             =encoding UTF-8
75              
76             =head1 NAME
77              
78             Config::Structured::Deserializer - Deserializes perl structures, JSON or YML data, from strings or files
79              
80             =head1 VERSION
81              
82             version 2.004
83              
84             =head1 AUTHOR
85              
86             Mark Tyrrell <mtyrrell@concertpharma.com>
87              
88             =head1 COPYRIGHT AND LICENSE
89              
90             This software is Copyright (c) 2023 by Concert Pharmaceuticals, Inc.
91              
92             This is free software, licensed under:
93              
94             The MIT (X11) License
95              
96             =cut