Merge pull request #110 from bayashi/accept-http-headers-obj

Able to accept HTTP::Headers object as arg
bayashi · Feb 6, 2022 · 75c4d66 · 75c4d66
2 parents cf0dece + 97bc169
commit 75c4d66
Show file tree

Hide file tree

Showing 3 changed files with 50 additions and 16 deletions.
diff --git a/cpanfile b/cpanfile
@@ -15,6 +15,7 @@ on 'test' => sub {
     requires 'List::Util';
     requires 'Test::More', '1.3';
     requires 'Test::AllModules', '0.17';
+    requires 'HTTP::Headers';
     # for CLI
     requires 'Capture::Tiny';
 };

diff --git a/lib/Duadua.pm b/lib/Duadua.pm
@@ -88,15 +88,8 @@ sub new {
     my $ua    = shift;
     my $opt   = shift || {};
 
-    if (!defined $ua) {
-        $ua = '';
-        if (exists $ENV{HTTP_USER_AGENT} && defined $ENV{HTTP_USER_AGENT}) {
-            $ua = $ENV{HTTP_USER_AGENT};
-        }
-    }
-
     bless {
-        _ua          => $ua,
+        _ua          => $class->_get_ua_string($ua),
         _parsed      => 0,
         _result      => {},
         _parsers     => $class->_build_parsers($opt),
@@ -128,14 +121,7 @@ sub ua { shift->{_ua} }
 sub reparse {
     my ($self, $ua) = @_;
 
-    if (!defined $ua) {
-        $ua = '';
-        if (exists $ENV{HTTP_USER_AGENT} && defined $ENV{HTTP_USER_AGENT}) {
-            $ua = $ENV{HTTP_USER_AGENT};
-        }
-    }
-
-    $self->{_ua}     = $ua;
+    $self->{_ua}     = $self->_get_ua_string($ua);
     $self->{_result} = {};
 
     return $self->_parse;
@@ -181,6 +167,20 @@ sub _parse {
     return $self;
 }
 
+sub _get_ua_string {
+    my ($self, $ua_raw) = @_;
+
+    if (!defined $ua_raw) {
+        return exists $ENV{HTTP_USER_AGENT} && defined $ENV{HTTP_USER_AGENT} ? $ENV{HTTP_USER_AGENT} : '';
+    }
+
+    if (ref($ua_raw) =~ m!^HTTP::Headers!) {
+        return $ua_raw->header('User-Agent');
+    }
+
+    return $ua_raw;
+}
+
 sub name {
     shift->_result->{name};
 }
@@ -240,6 +240,21 @@ Or call as a function to parse immediately
     $d->is_bot
         and say $d->name; # Googlebot
 
+And it's able to accept an object like L<HTTP::Headers> instead of user-agent string.
+
+    use HTTP::Headers;
+    use Duadua;
+
+    my $headers = HTTP::Headers->new(
+        'User_Agent' => 'Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)'
+    );
+
+    my $d = Duadua->new($headers);
+    $d->is_bot
+        and say $d->name; # Googlebot
+
+B<NOTE> that an object class should be HTTP::Headers[::*], and it should have a method `header` to get specific HTTP-Header.
+
 If you would like to parse many times, then you can use C<reparse> method. It's fast.
 
     my $d = Duadua->new;

diff --git a/t/10_basic.t b/t/10_basic.t
@@ -2,6 +2,7 @@ use strict;
 use warnings;
 use Test::More;
 
+use HTTP::Headers;
 use Duadua;
 
 {
@@ -167,4 +168,21 @@ use Duadua;
     is $d->version, '2.1';
 }
 
+{
+    my $headers = HTTP::Headers->new(
+        User_Agent => 'Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)',
+    );
+    my $d = Duadua->new($headers, { version => 1 });
+
+    is $d->name, 'Googlebot', 'version';
+    ok $d->opt_version;
+    ok $d->is_bot;
+    ok !$d->is_ios;
+    ok !$d->is_android;
+    ok !$d->is_linux;
+    ok !$d->is_windows;
+    ok !$d->is_chromeos;
+    is $d->version, '2.1';
+}
+
 done_testing;