diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml index 928e27f..81ee4fc 100644 --- a/.github/workflows/linux.yml +++ b/.github/workflows/linux.yml @@ -32,6 +32,7 @@ jobs: env: CIP_TAG: ${{ matrix.cip_tag }} + CIP_ENV: WEBSERVICE_WTFISMYIP_LIVE_TESTS=1 steps: - uses: actions/checkout@v2 diff --git a/README.md b/README.md new file mode 100644 index 0000000..494d294 --- /dev/null +++ b/README.md @@ -0,0 +1,56 @@ +# WebService::WTFIsMyIP ![static](https://github.com/uperl/WebService-WTFIsMyIP/workflows/static/badge.svg) ![linux](https://github.com/uperl/WebService-WTFIsMyIP/workflows/linux/badge.svg) + +Client for wtfismyip.com + +# SYNOPSIS + +```perl +use WebService::WTFIsMyIP; + +my $wtfismyip = WebService::WTFIsMyIP->new; +say "your IP is", $wtfismyip->json->{IPAddress}; +``` + +# DESCRIPTION + +This class provides an interface to the [wtfismyip](https://wtfismyip.com) service. + +# CONSTRUCTOR + +```perl +my $wtfismyip = WebService::WTFIsMyIP->new(%attributes); +``` + +Create a new instance of the client. Attributes available: + +- ua + + Should be an instance of [HTTP::AnyUA](https://metacpan.org/pod/HTTP::AnyUA), or any class supported by [HTTP::AnyUA](https://metacpan.org/pod/HTTP::AnyUA). + [HTTP::Tiny](https://metacpan.org/pod/HTTP::Tiny) is used by default. + +- base\_url + + The base URL to use. `https://wtfismyip.com/` is used by default. + +# METHODS + +## json + +```perl +my %hash = $wtfismyip->json->%*; +``` + +Returns a hash that contains fields such as `IPAddress` and `ISP`. The method +is so named after the endpoint that it calls, although the return value is converted +into a Perl hash ref. + +# AUTHOR + +Graham Ollis + +# COPYRIGHT AND LICENSE + +This software is copyright (c) 2025 by Graham Ollis. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff --git a/author.yml b/author.yml index c64a272..be3922e 100644 --- a/author.yml +++ b/author.yml @@ -5,10 +5,14 @@ pod_spelling_system: # (regardless of what spell check thinks) # or stuff that I like to spell incorrectly # intentionally - stopwords: [] + stopwords: + - wtfismyip + - WTF + - ua pod_coverage: skip: 0 # format is "Class#method" or "Class",regex allowed # for either Class or method. - private: [] + private: + - .*#BUILD diff --git a/dist.ini b/dist.ini index 193aa5f..8f3e160 100644 --- a/dist.ini +++ b/dist.ini @@ -21,4 +21,5 @@ version_plugin = PkgVersion::Block [Author::Plicease::Upload] cpan = 1 - +[PruneFiles] +filename = xt/author/strict.t diff --git a/lib/WebService/WTFIsMyIP.pm b/lib/WebService/WTFIsMyIP.pm index 7550955..3d0f95b 100644 --- a/lib/WebService/WTFIsMyIP.pm +++ b/lib/WebService/WTFIsMyIP.pm @@ -1,9 +1,98 @@ use warnings; use 5.020; -use experimental qw( postderef signatures ); +use experimental qw( signatures ); +use stable qw( postderef ); use true; package WebService::WTFIsMyIP { # ABSTRACT: Client for wtfismyip.com + +=head1 SYNOPSIS + + use WebService::WTFIsMyIP; + + my $wtfismyip = WebService::WTFIsMyIP->new; + say "your IP is", $wtfismyip->json->{IPAddress}; + +=head1 DESCRIPTION + +This class provides an interface to the L service. + +=head1 CONSTRUCTOR + + my $wtfismyip = WebService::WTFIsMyIP->new(%attributes); + +Create a new instance of the client. Attributes available: + +=over 4 + +=item ua + +Should be an instance of L, or any class supported by L. +L is used by default. + +=item base_url + +The base URL to use. C is used by default. + +=back + +=cut + + use Ref::Util qw( is_blessed_ref ); + use JSON::MaybeXS qw( decode_json ); + use Class::Tiny { + ua => sub { + require HTTP::Tiny; + return HTTP::Tiny->new; + }, + base_url => "https://wtfismyip.com/", + }; + + sub BUILD ($self, $) { + unless(is_blessed_ref $self->ua) { + die "ua must be an instance of HTTP::AnyUA or a user agent supported by HTTP::AnyUA"; + } + unless($self->ua->isa("HTTP::AnyUA")) { + require HTTP::AnyUA; + $self->ua(HTTP::AnyUA->new($self->ua)); + } + + unless(is_blessed_ref $self->base_url && $self->base_url->isa("URI")) { + require URI; + $self->base_url(URI->new("@{[ $self->base_url ]}")); + } + } + +=head1 METHODS + +=head2 json + + my %hash = $wtfismyip->json->%*; + +Returns a hash that contains fields such as C and C. The method +is so named after the endpoint that it calls, although the return value is converted +into a Perl hash ref. + +=cut + + sub json ($self) { + + my $url = $self->base_url->clone; + $url->path("/json"); + + my $res = $self->ua->get($url); + if($res->{success}) { + my %hash = decode_json($res->{content})->%*; + foreach my $key (keys %hash) { + my $new_key = $key =~ s/^YourFucking//r; + $hash{$new_key} = delete $hash{$key} if $key ne $new_key; + } + return \%hash; + } else { + die sprintf("%s %s: %s", $res->{status}, $res->{reason}, $url);; + } + } + } diff --git a/maint/cip-before-install b/maint/cip-before-install new file mode 100755 index 0000000..fec2fa3 --- /dev/null +++ b/maint/cip-before-install @@ -0,0 +1,5 @@ +#!/bin/bash + +set -ex + +cip exec cpanm -n IO::Socket::SSL diff --git a/t/00_diag.t b/t/00_diag.t new file mode 100644 index 0000000..999f3ef --- /dev/null +++ b/t/00_diag.t @@ -0,0 +1,96 @@ +use Test2::V0 -no_srand => 1; +use Config; + +eval { require 'Test/More.pm' }; + +# This .t file is generated. +# make changes instead to dist.ini + +my %modules; +my $post_diag; + +$modules{$_} = $_ for qw( + Class::Tiny + Cpanel::JSON::XS + ExtUtils::MakeMaker + HTTP::AnyUA + JSON::MaybeXS + JSON::PP + JSON::XS + Ref::Util + Test2::Require::EnvVar + Test2::V0 + URI + true +); + + + +my @modules = sort keys %modules; + +sub spacer () +{ + diag ''; + diag ''; + diag ''; +} + +pass 'okay'; + +my $max = 1; +$max = $_ > $max ? $_ : $max for map { length $_ } @modules; +our $format = "%-${max}s %s"; + +spacer; + +my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV; + +if(@keys > 0) +{ + diag "$_=$ENV{$_}" for @keys; + + if($ENV{PERL5LIB}) + { + spacer; + diag "PERL5LIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERL5LIB}; + + } + elsif($ENV{PERLLIB}) + { + spacer; + diag "PERLLIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERLLIB}; + } + + spacer; +} + +diag sprintf $format, 'perl', "$] $^O $Config{archname}"; + +foreach my $module (sort @modules) +{ + my $pm = "$module.pm"; + $pm =~ s{::}{/}g; + if(eval { require $pm; 1 }) + { + my $ver = eval { $module->VERSION }; + $ver = 'undef' unless defined $ver; + diag sprintf $format, $module, $ver; + } + else + { + diag sprintf $format, $module, '-'; + } +} + +if($post_diag) +{ + spacer; + $post_diag->(); +} + +spacer; + +done_testing; + diff --git a/t/webservice_wtfismyip.t b/t/webservice_wtfismyip.t index 394b3f8..9b0deee 100644 --- a/t/webservice_wtfismyip.t +++ b/t/webservice_wtfismyip.t @@ -1,6 +1,39 @@ use Test2::V0 -no_srand => 1; use WebService::WTFIsMyIP; +use Test2::Require::EnvVar 'WEBSERVICE_WTFISMYIP_LIVE_TESTS'; +use stable qw( postderef ); -ok 1, 'todo'; +is( + WebService::WTFIsMyIP->new, + object { + prop 'blessed' => 'WebService::WTFIsMyIP'; + call ua => object { + prop 'isa' => 'HTTP::AnyUA'; + }; + call base_url => object { + prop 'isa' => 'URI'; + }; + call json => hash { + field 'IPAddress' => D(); + field 'ISP' => D(); + etc; + }; + }, +); + +{ + diag ''; + diag ''; + diag ''; + + my %hash = WebService::WTFIsMyIP->new->json->%*; + + foreach my $key (sort keys %hash) { + diag "$key=$hash{$key}"; + } + + diag ''; + diag ''; +} done_testing;