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