File Coverage

lib/Transmission/Types.pm
Criterion Covered Total %
statement 15 15 100.0
branch 2 2 100.0
condition 3 3 100.0
subroutine 5 5 100.0
pod n/a
total 25 25 100.0


line stmt bran cond sub pod time code
1             # ex:ts=4:sw=4:sts=4:et
2             package Transmission::Types;
3             # See Transmission::Client for copyright statement.
4              
5             =head1 NAME
6              
7             Transmission::Types - Moose types for Transmission
8              
9             =head1 DESCRIPTION
10              
11             The types below is pretty much what you would expect them to be, execpt
12             for some (maybe weird?) default values - that is for coercion from "Any".
13              
14             The type names correspond to types used in the Transmission RPC
15             specification.
16              
17             =head1 TYPES
18              
19             =head2 number
20              
21             =head2 double
22              
23             =head2 string
24              
25             =head2 boolean
26              
27             =head2 array
28              
29             =cut
30              
31 6     6   113047 use MooseX::Types -declare => [qw/number double string boolean array/];
  6         741094  
  6         40  
32 6     6   45795 use MooseX::Types::Moose ':all';
  6         106231  
  6         53  
33 6     6   52034 use B;
  6         102  
  6         3858  
34              
35             # If Perl thinks a value is a string, JSON will encode it as such. But
36             # Transmission is picky about how parameters are encoded in the JSON
37             # request, so we make sure Perl knows how to store numeric types.
38             sub _coerce_num {
39 16     16   38 local $_ = shift;
40 16 100 100     294 return -1 unless defined $_ and /^[0-9]+(?:\.[0-9]+)?$/;
41 7         68 return 0+$_;
42             }
43              
44             sub _is_num {
45 37     37   201 my $sv = shift;
46 37         277 my $flags = B::svref_2object(\$sv)->FLAGS;
47              
48             # Make sure perl internally thinks of $sv as an integer
49             # or numeric value. In earlier releases I also made sure that
50             # it's not a string ($flags & B::SVp_POK), but POK and
51             # (NOK|IOK) seem to be mutually exclusive.
52 37         195 return $flags & (B::SVp_NOK | B::SVp_IOK);
53             }
54              
55             subtype number, as Num, where { _is_num($_) and $_ == int $_};
56             coerce number, from Any, via { int _coerce_num($_) };
57              
58             subtype double, as Num, where { _is_num($_) };
59             coerce double, from Any, via { _coerce_num($_) };
60              
61             subtype string, as Str;
62             coerce string, from Any, via { defined $_ ? "$_" : "__UNDEF__" };
63              
64             type boolean, where { defined $_ and $_ =~ /^(1|0)$/ };
65             coerce boolean, from Object, via { int $_ };
66              
67             subtype array, as ArrayRef;
68             coerce array, from Any, via { [] };
69              
70             =head1 LICENSE
71              
72             =head1 NAME
73              
74             See L<Transmission::Client>
75              
76             =cut
77              
78             1;