1package GeoIP2::Types;
2
3use strict;
4use warnings;
5
6our $VERSION = '2.006002';
7
8use Data::Validate::IP ();
9use GeoIP2::Error::Type;
10use List::SomeUtils ();
11use Scalar::Util    ();
12use Sub::Quote qw( quote_sub );
13use URI;
14
15use namespace::clean;
16
17use Exporter qw( import );
18
19our @EXPORT_OK = qw(
20    ArrayRef
21    Bool
22    BoolCoercion
23    HTTPStatus
24    HashRef
25    IPAddress
26    JSONObject
27    LocalesArrayRef
28    MaxMindID
29    MaxMindLicenseKey
30    MaybeStr
31    NameHashRef
32    NonNegativeInt
33    Num
34    PositiveInt
35    Str
36    URIObject
37    UserAgentObject
38    object_can_type
39    object_isa_type
40);
41
42our %EXPORT_TAGS = ( all => \@EXPORT_OK );
43
44## no critic (NamingConventions::Capitalization, ValuesAndExpressions::ProhibitImplicitNewlines)
45sub ArrayRef () {
46    return quote_sub(
47        q{ GeoIP2::Types::_tc_fail( $_[0], 'ArrayRef' )
48               unless defined $_[0]
49               && ref $_[0]
50               && Scalar::Util::reftype( $_[0] ) eq 'ARRAY'
51               && ! Scalar::Util::blessed( $_[0] ); }
52    );
53}
54
55sub Bool () {
56    return quote_sub(
57        q{ GeoIP2::Types::_tc_fail( $_[0], 'Bool' )
58              unless ( ( defined $_[0] && !ref $_[0] && $_[0] =~ /^(?:0|1|)$/ )
59              || !defined $_[0] ); }
60    );
61}
62
63sub BoolCoercion () {
64    return quote_sub(
65        q{ defined $_[0] && Scalar::Util::blessed($_[0])
66               && ( $_[0]->isa('JSON::Boolean')
67                    || $_[0]->isa('JSON::PP::Boolean')
68                    || $_[0]->isa('JSON::XS::Boolean')
69                    || $_[0]->isa('Cpanel::JSON::XS::Boolean')
70                  )
71                ? $_[0] + 0 : $_[0] }
72    );
73}
74
75sub HTTPStatus () {
76    return quote_sub(
77        q{ GeoIP2::Types::_tc_fail( $_[0], 'HTTPStatus' )
78               unless defined $_[0]
79               && ! ref $_[0]
80               && $_[0] =~ /^[2345]\d\d$/ }
81    );
82}
83
84sub HashRef () {
85    return quote_sub(
86        q{ GeoIP2::Types::_tc_fail( $_[0], 'HashRef' )
87               unless defined $_[0]
88               && ref $_[0]
89               && Scalar::Util::reftype( $_[0] ) eq 'HASH'
90               && ! Scalar::Util::blessed( $_[0] ); }
91    );
92}
93
94sub IPAddress {
95    return quote_sub(
96        q{ GeoIP2::Types::_tc_fail( $_[0], 'IPAddress' )
97               unless Data::Validate::IP::is_ip( $_[0] ); }
98    );
99}
100
101sub JSONObject () {
102    return quote_sub(q{ GeoIP2::Types::object_can_type( $_[0], 'decode' ) });
103}
104
105{
106    ## no critic (Variables::ProhibitPackageVars)
107    our %_SupportedLangs = map { $_ => 1 } qw(
108        de
109        en
110        es
111        fr
112        ja
113        pt-BR
114        ru
115        zh-CN
116    );
117
118    sub LocalesArrayRef () {
119        return quote_sub(
120            q{ GeoIP2::Types::_tc_fail( $_[0], 'LocalesArrayRef' )
121                   unless ref $_[0]
122                   && Scalar::Util::reftype( $_[0] ) eq 'ARRAY'
123                   && !Scalar::Util::blessed( $_[0] )
124                   && List::SomeUtils::all(
125                   sub { defined $_ && !ref $_ && $GeoIP2::Types::_SupportedLangs{$_} },
126                   @{ $_[0] }
127                   ); }
128        );
129    }
130}
131
132# Same as PositiveInt
133sub MaxMindID () {
134    return quote_sub(
135        q{ GeoIP2::Types::_tc_fail( $_[0], 'MaxMindID' )
136               unless defined $_[0]
137               && ! ref $_[0]
138               && $_[0] =~ /^\d+$/
139               && $_[0] > 0; }
140    );
141}
142
143sub MaxMindLicenseKey () {
144    return quote_sub(
145        q{ GeoIP2::Types::_tc_fail( $_[0], 'MaxMindLicenseKey' )
146               unless defined $_[0]
147               && ! ref $_[0]
148               && $_[0] =~ /^\S{12,}$/; }
149    );
150}
151
152sub MaybeStr () {
153    return quote_sub(
154        q{ GeoIP2::Types::_tc_fail( $_[0], 'StrOrUndef' )
155               unless !ref $_[0]; }
156    );
157}
158
159sub NameHashRef () {
160    return quote_sub(
161        q{ GeoIP2::Types::_tc_fail( $_[0], 'NameHashRef' )
162               unless ref $_[0]
163               && Scalar::Util::reftype( $_[0] ) eq 'HASH'
164               && ! Scalar::Util::blessed( $_[0] )
165               && &List::SomeUtils::all( sub { defined $_ && ! ref $_ }, values %{ $_[0] } ); }
166    );
167}
168
169sub NonNegativeInt () {
170    return quote_sub(
171        q{ GeoIP2::Types::_tc_fail( $_[0], 'NonNegativeInt' )
172               unless defined $_[0]
173               && ! ref $_[0]
174               && $_[0] =~ /^\d+$/
175               && $_[0] >= 0; }
176    );
177}
178
179sub Num () {
180    return quote_sub(
181        q{ GeoIP2::Types::_tc_fail( $_[0], 'Num' )
182               unless defined $_[0]
183               && ! ref $_[0]
184               && $_[0] =~ /^-?\d+(\.\d+)?$/; }
185    );
186}
187
188sub PositiveInt () {
189    return quote_sub(
190        q{ GeoIP2::Types::_tc_fail( $_[0], 'PositiveInt' )
191               unless defined $_[0]
192               && ! ref $_[0]
193               && $_[0] =~ /^\d+$/
194               && $_[0] > 0; }
195    );
196}
197
198sub Str () {
199    return quote_sub(
200        q{ GeoIP2::Types::_tc_fail( $_[0], 'Str' )
201               unless defined $_[0]
202               && ! ref $_[0]; }
203    );
204}
205
206sub URIObject () {
207    return quote_sub(q{ GeoIP2::Types::object_isa_type( $_[0], 'URI' ) });
208}
209
210sub UserAgentObject () {
211    return quote_sub(
212        q{ GeoIP2::Types::object_can_type( $_[0], 'agent', 'request' ) });
213}
214
215## use critic
216
217sub object_can_type {
218    my $thing   = shift;
219    my @methods = @_;
220
221    _tc_fail( $thing, 'Object' )
222        unless defined $thing
223        && Scalar::Util::blessed($thing);
224
225    for my $method (@methods) {
226        _tc_fail( $thing, "Object which ->can($method)" )
227            unless $thing->can($method);
228    }
229}
230
231sub object_isa_type {
232    my $thing = shift;
233    my $class = shift;
234
235    _tc_fail( $thing, "$class Object" )
236        unless defined $thing
237        && Scalar::Util::blessed($thing)
238        && $thing->isa($class);
239}
240
241sub _tc_fail {
242    my $value = shift;
243    my $type  = shift;
244
245    $value
246        = !defined $value
247        ? 'undef'
248        : $value;
249
250    GeoIP2::Error::Type->throw(
251        message => "$value is not a valid $type",
252        type    => $type,
253        value   => $value
254    );
255}
256
2571;
258