Skip to content
Browse files

Implement $ua->is_online test

Inspired by LWP::Online
  • Loading branch information...
1 parent 4eedf47 commit 2342653ba0105bc8a25b535b1aa0f4ed9a74a97a @gisle committed Feb 18, 2012
Showing with 29 additions and 0 deletions.
  1. +1 −0 MANIFEST
  2. +15 −0 lib/LWP/UserAgent.pm
  3. +13 −0 t/live/online.t
View
1 MANIFEST
@@ -39,6 +39,7 @@ t/TEST Run tests
t/base/protocols.t Test protocol methods of LWP::UserAgent
t/base/ua.t Basic LWP::UserAgent tests
t/live/apache-http10.t
+t/live/online.t
t/live/jigsaw-auth-b.t
t/live/jigsaw-auth-d.t
t/live/jigsaw-chunk.t
View
15 lib/LWP/UserAgent.pm
@@ -476,6 +476,15 @@ sub _process_colonic_headers {
return $arg;
}
+
+sub is_online {
+ my $self = shift;
+ return 1 if $self->get("http://www.msftncsi.com/ncsi.txt")->content eq "Microsoft NCSI";
+ return 1 if $self->get("http://www.apple.com")->content =~ m,<title>Apple</title>,;
+ return 0;
+}
+
+
my @ANI = qw(- \ | /);
sub progress {
@@ -1700,6 +1709,12 @@ The difference from request() is that simple_request() will not try to
handle redirects or authentication responses. The request() method
will in fact invoke this method for each simple request it sends.
+=item $ua->is_online
+
+Tries to determine if you have access to the Internet. Returns
+TRUE if the built-in heuristics determine that the user agent is
+able to access the Internet (over HTTP). See also L<LWP::Online>.
+
=item $ua->is_protocol_supported( $scheme )
You can use this method to test whether this user agent object supports the
View
13 t/live/online.t
@@ -0,0 +1,13 @@
+#!perl -w
+
+use strict;
+use Test;
+plan tests => 2;
+
+use LWP::UserAgent;
+my $ua = LWP::UserAgent->new;
+
+ok $ua->is_online;
+
+$ua->protocols_allowed([]);
+ok !$ua->is_online;

0 comments on commit 2342653

Please sign in to comment.
Something went wrong with that request. Please try again.