File Coverage

blib/lib/Duadua.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	32	32	100.0
condition	4	5	80.0
subroutine	21	21	100.0
pod	14	14	100.0
total	132	133	99.2

package Duadua;
use strict;
use warnings;
use Duadua::Parser;

our $VERSION = '0.27';

my @PARSER_PROC_LIST = qw/
    Duadua::Parser::Browser::MicrosoftEdge
    Duadua::Parser::Browser::GoogleChrome
    Duadua::Parser::Browser::MicrosoftInternetExplorer

    Duadua::Parser::Bot::Googlebot
    Duadua::Parser::Bot::GooglebotMobile
    Duadua::Parser::Bot::GooglebotAd
    Duadua::Parser::Bot::GoogleRead
    Duadua::Parser::Bot::Bingbot
    Duadua::Parser::Bot::AdIdxBot
    Duadua::Parser::Bot::BingPreview

    Duadua::Parser::Browser::Opera
    Duadua::Parser::Browser::MozillaFirefox

    Duadua::Parser::Browser::YahooJapanAppBrowser

    Duadua::Parser::Browser::AppleSafari
    Duadua::Parser::Browser::Vivaldi

    Duadua::Parser::Bot::Huawei
    Duadua::Parser::Bot::Sakura
    Duadua::Parser::HTTPClient::HTTPClient

    Duadua::Parser::Bot::Twitterbot
    Duadua::Parser::Bot::FacebookCrawler
    Duadua::Parser::Bot::Slackbot

    Duadua::Parser::Bot::YahooSlurp
    Duadua::Parser::Bot::Baiduspider
    Duadua::Parser::Bot::YandexBot
    Duadua::Parser::Bot::GooglebotMisc
    Duadua::Parser::Bot::DuckDuckBot
    Duadua::Parser::Bot::Applebot
    Duadua::Parser::Bot::Msnbot
    Duadua::Parser::Bot::BotMisc
    Duadua::Parser::Bot::Log4Shell

    Duadua::Parser::Browser::GoogleApp
    Duadua::Parser::Browser::SamsungInternetBrowser
    Duadua::Parser::Browser::Yandex
    Duadua::Parser::Browser::DuckDuckGo
    Duadua::Parser::Bot::OracleGrapeshotCrawler
    Duadua::Parser::Bot::MailRUBot
    Duadua::Parser::Browser::PaleMoon
    Duadua::Parser::Browser::UCBrowser
    Duadua::Parser::Browser::BrowserMisc

    Duadua::Parser::Bot::YahooJapanBot
    Duadua::Parser::Bot::HatenaBot
    Duadua::Parser::Bot::Feedly
    Duadua::Parser::Bot::Reeder
    Duadua::Parser::Bot::QuiteRSS
    Duadua::Parser::Bot::Feedbin
    Duadua::Parser::Bot::Inoreader
    Duadua::Parser::Bot::Fastladder
    Duadua::Parser::Bot::Feedeen
    Duadua::Parser::Bot::Feedspot
    Duadua::Parser::Bot::OldReader
    Duadua::Parser::Bot::Flipboard
    Duadua::Parser::Bot::Skype

    Duadua::Parser::Browser::Xiaomi
    Duadua::Parser::FeaturePhone::FeaturePhone
    Duadua::Parser::Bot::Netcraft
    Duadua::Parser::Bot::Barkrowler
    Duadua::Parser::Bot::SMTBot
    Duadua::Parser::Bot::AdstxtCom
    Duadua::Parser::Bot::CentroAdsCrawler
    Duadua::Parser::Bot::LetsEncrypt
/;

for my $parser (@PARSER_PROC_LIST) {
    eval "require $parser;"; ## no critic
    die "Could not load $parser, $@" if $@;
}

sub new {
    my $class = shift;
    my $ua    = shift;
    my $opt   = shift || {};

    bless {
        _ua          => $class->_get_ua_string($ua),
        _parsed      => 0,
        _result      => {},
        _parsers     => $class->_build_parsers($opt),
        _opt_version => $opt->{version},
    }, $class;
}

sub _build_parsers {
    my ($class, $opt) = @_;

    if (exists $opt->{skip}) {
        my @parsers;
        for my $p (@PARSER_PROC_LIST) {
            next if grep { $p eq $_ } @{$opt->{skip}};
            push @parsers, $p;
        }
        return \@parsers;
    }

    return \@PARSER_PROC_LIST;
}

sub opt_version { shift->{_opt_version} }

sub parsers { shift->{_parsers} }

sub ua { shift->{_ua} }

sub reparse {
    my ($self, $ua) = @_;

    $self->{_ua}     = $self->_get_ua_string($ua);
    $self->{_result} = {};

    return $self->_parse;
}

sub _result {
    my ($self, $value) = @_;

    if ($value) {
        $self->{_result} = $value;
        return $self;
    }
    else {
        $self->parse unless $self->{_parsed};
        return $self->{_result};
    }
}

sub parse {
    my $self = shift;

    if (ref $self eq __PACKAGE__) {
        $self->_parse;
    }
    elsif ($self eq __PACKAGE__) {
        # my $d_obj = Duadua->parse('User-Agent String', $opt);
        my $d = __PACKAGE__->new(@_);
        return $d->_parse;
    }
    else {
        # my $d_obj = Duadua::parse('User-Agent String', $opt);
        my $d = __PACKAGE__->new($self, @_);
        return $d->_parse;
    }
}

sub _parse {
    my $self = shift;

    $self->_result(Duadua::Parser->parse($self));
    $self->{_parsed} = 1;

    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};
}

sub is_bot {
    shift->_result->{is_bot} ? 1 : 0;
}

sub is_ios {
    shift->_result->{is_ios} ? 1 : 0;
}

sub is_android {
    shift->_result->{is_android} ? 1 : 0;
}

sub is_linux {
    shift->_result->{is_linux} ? 1 : 0;
}

sub is_windows {
    shift->_result->{is_windows} ? 1 : 0;
}

sub is_chromeos {
    shift->_result->{is_chromeos} ? 1 : 0;
}

sub version {
    shift->_result->{version} || '';
}

1;

__END__