File Coverage

blib/lib/TOML/Tiny/Util.pm
Criterion Covered Total %
statement 29 35 82.8
branch 4 8 50.0
condition 2 2 100.0
subroutine 7 7 100.0
pod 0 1 0.0
total 42 53 79.2


line stmt bran cond sub pod time code
1             package TOML::Tiny::Util;
2             # ABSTRACT: utility functions used by TOML::Tiny
3             $TOML::Tiny::Util::VERSION = '0.20';
4 286     286   1896 use strict;
  286         578  
  286         11271  
5 286     286   1396 use warnings;
  286         670  
  286         15468  
6 286     286   1472 no warnings 'experimental';
  286         576  
  286         10148  
7 286     286   3619 use v5.18;
  286         1158  
8              
9 286     286   1597 use TOML::Tiny::Grammar;
  286         564  
  286         75742  
10              
11 286     286   2120 use parent 'Exporter';
  286         535  
  286         2744  
12              
13             our @EXPORT_OK = qw(
14             is_strict_array
15             );
16              
17             my @_type_map = (
18             [ qr{Float}, 'float' ],
19             [ qr{Int}, 'integer' ],
20             [ qr{Boolean}, 'bool' ],
21             [ qr{^$Boolean}, 'bool' ],
22             [ qr{^$Float}, 'float' ],
23             [ qr{^$Integer}, 'integer' ],
24             [ qr{^$DateTime}, 'float' ],
25             );
26              
27             sub is_strict_array {
28 2     2 0 2 my $arr = shift;
29              
30             my @types = map{
31 2         4 my $value = $_;
  2         3  
32 2         3 my $type;
33              
34 2         5 my $ref = ref($value);
35 2 100       6 if ($ref eq 'ARRAY') {
    50          
36 1         2 $type = 'array';
37             }
38             elsif ($ref eq 'HASH') {
39 0         0 $type = 'table';
40             }
41             # Do a little heuristic guess-work
42             else {
43 1         2 for my $pair (@_type_map) {
44 1 50       7 if ( $ref =~ m{$pair->[0]} ) {
45 0         0 $type = $pair->[1];
46             }
47 1         2 last;
48             }
49             }
50 2   100     6 $type //= 'string';
51              
52 2         6 return $type;
53             } @$arr;
54              
55 0           my $t = shift @types;
56              
57 0           for (@types) {
58 0 0         return (undef, "expected value of type $t, but found $_")
59             if $_ ne $t;
60             }
61              
62 0           return (1, undef);
63             }
64              
65             1;
66              
67             __END__
68              
69             =pod
70              
71             =encoding UTF-8
72              
73             =head1 NAME
74              
75             TOML::Tiny::Util - utility functions used by TOML::Tiny
76              
77             =head1 VERSION
78              
79             version 0.20
80              
81             =head1 AUTHOR
82              
83             Jeff Ober <sysread@fastmail.fm>
84              
85             =head1 COPYRIGHT AND LICENSE
86              
87             This software is copyright (c) 2025 by Jeff Ober.
88              
89             This is free software; you can redistribute it and/or modify it under
90             the same terms as the Perl 5 programming language system itself.
91              
92             =cut