File Coverage

blib/lib/Text/Xslate/Bridge/TypeDeclaration.pm
Criterion Covered Total %
statement 77 77 100.0
branch 28 30 93.3
condition 11 14 78.5
subroutine 21 21 100.0
pod 0 1 0.0
total 137 143 95.8


line stmt bran cond sub pod time code
1             package Text::Xslate::Bridge::TypeDeclaration;
2 10     10   523496 use strict;
  10         35  
  10         431  
3 10     10   73 use warnings;
  10         26  
  10         792  
4 10     10   520 use parent qw(Text::Xslate::Bridge);
  10         707  
  10         95  
5              
6 10     10   55544 use Carp qw(croak);
  10         50  
  10         598  
7 10     10   4327 use List::MoreUtils qw(all);
  10         98372  
  10         154  
8 10     10   9383 use Scalar::Util qw(blessed);
  10         34  
  10         938  
9 10     10   83 use Text::Xslate qw(mark_raw);
  10         31  
  10         688  
10 10     10   5008 use Text::Xslate::Bridge::TypeDeclaration::Registry;
  10         49  
  10         132  
11 10     10   1312 use Type::Registry ();
  10         28  
  10         201  
12 10     10   17147 use Type::Tiny qw();
  10         137840  
  10         421  
13 10     10   5179 use Types::Standard qw(Any Dict slurpy);
  10         559129  
  10         170  
14              
15             our $VERSION = '0.12_1';
16              
17             # Set truthy value to skip validation for local scope.
18             our $DISABLE_VALIDATION = 0;
19              
20             our $IMPORT_DEFAULT_ARGS = {
21             method => 'declare',
22             validate => 1,
23             print => 1,
24             on_mismatch => 'die', # Cannot give a subroutine reference >_<
25             registry_class => undef, # Class name for Type::Registry to lookup types
26             };
27              
28             sub export_into_xslate {
29 14     14 0 69981 my $class = shift;
30 14         44 my $funcs_ref = shift;
31              
32 14 50       91 my $args = @_ == 1 ? shift : { @_ };
33 14 50 33     156 croak sprintf '%s can receive either a hash or a hashref.', $class
34             unless ref $args && ref($args) eq 'HASH';
35              
36 14         92 for my $key (keys %$IMPORT_DEFAULT_ARGS) {
37 70 100       242 $args->{$key} = $IMPORT_DEFAULT_ARGS->{$key} unless defined $args->{$key};
38             }
39              
40             my $registry = defined $args->{registry_class}
41             ? Type::Registry->for_class($args->{registry_class})
42 14 100       177 : Text::Xslate::Bridge::TypeDeclaration::Registry->new;
43              
44 14         108 $class->bridge(function => { $args->{method} => _declare_func($args, $registry) });
45 14         327 $class->SUPER::export_into_xslate($funcs_ref, @_);
46             }
47              
48             sub _declare_func {
49 14     14   60 my ($args, $registry) = @_;
50              
51             return sub {
52 39 100 100 39   781847 return if $DISABLE_VALIDATION || !$args->{validate};
53              
54 36         281 while (my ($key, $declaration) = splice(@_, 0, 2)) {
55 52         552 my $type = _type($declaration, $registry);
56 52         12139 my $value = Text::Xslate->current_vars->{$key};
57              
58 52 100       240 unless ($type->check($value)) {
59 24         350 my $msg = sprintf(
60             "Declaration mismatch for `%s`\n %s\n", $key, $type->get_message($value)
61             );
62 24 100       2364 _print($msg) if $args->{print};
63 24 100       146 last if _on_mismatch($msg, $args->{on_mismatch});
64             }
65             };
66              
67 36         1388 return;
68 14         498 };
69             }
70              
71             # This treats unknown types as a declaration error.
72             sub _get_invalid_type {
73 20     20   443 my ($name) = @_;
74              
75             return Type::Tiny->new(
76       12     constraint => sub { },
77 6     6   489 message => sub { "\"$name\" is not a known type" },
78 20         284 );
79             }
80              
81             # returns: Type::Tiny
82             sub _type {
83 168     168   11936 my ($name_or_struct, $registry) = @_;
84              
85 168 100 100     2286 return _get_invalid_type($name_or_struct)
86             if !defined $name_or_struct || $name_or_struct eq '';
87              
88 161 100       613 if (my $ref = ref $name_or_struct) {
89 29 100       172 return _hash_structure($name_or_struct, $registry) if $ref eq 'HASH';
90 5         25 return _get_invalid_type($name_or_struct);
91             } else {
92 132         322 my $type = eval { $registry->lookup($name_or_struct) };
  132         743  
93 132 100 66     30034 return ($type && blessed($type) && $type->can('check'))
94             ? $type : _get_invalid_type($name_or_struct);
95             }
96             }
97              
98             sub _hash_structure {
99 48     48   363 my ($hash, $registry) = @_;
100              
101             return Dict[
102 48         257 (map { $_ => _type($hash->{$_}, $registry) } keys %$hash),
  95         16382  
103             slurpy Any
104             ];
105             }
106              
107             sub _print {
108 23     23   83 my ($msg) = @_;
109              
110 23   100     273 my $is_html = (Text::Xslate->current_engine->{type} || '') ne 'text';
111              
112 23 100       235 my @outputs = $is_html
113             ? (mark_raw("
\n"), $msg, mark_raw("
\n"))
114             : (mark_raw($msg));
115              
116 23         1482 Text::Xslate->print(@outputs);
117             }
118              
119             sub _on_mismatch {
120 24     24   98 my ($msg, $func) = @_;
121              
122             my $h = +{
123             die => [ 'die_handler', 1 ],
124             warn => [ 'warn_handler', 0 ],
125             none => [ undef, 0 ]
126 24         242 }->{$func};
127              
128 24 100       144 if ($h->[0]) {
129 21         114 my $handler = Text::Xslate->current_engine->{$h->[0]};
130 21 100       93 $handler->($msg) if $handler;
131             }
132 24         173 return $h->[1];
133             }
134              
135             1;
136              
137             __END__