File Coverage

blib/lib/HTML/ParseBrowser.pm

Criterion	Covered	Total	%
statement	169	183	92.3
branch	97	116	83.6
condition	26	47	55.3
subroutine	7	8	87.5
pod	2	2	100.0
total	301	356	84.5

package HTML::ParseBrowser;
$HTML::ParseBrowser::VERSION = '1.13';
use 5.006;
use strict;
use warnings;

use vars qw($AUTOLOAD);

my %lang =
(
    'en' => 'English',
    'de' => 'German',
    'fr' => 'French',
    'es' => 'Spanish',
    'it' => 'Italian',
    'da' => 'Danish',
    'ja' => 'Japanese',
    'ru' => 'Russian',
);
my $langRE = join('|', keys %lang);

my %name_map =
(
    'Mozilla'   => 'Netscape',
    'Gecko'     => 'Mozilla',
    'Netscape6' => 'Netscape',
    'MSIE'      => 'Internet Explorer',
);

sub new {
    my $class   = shift;
    my $browser = {};
    bless $browser, ref $class || $class;
    $browser->Parse(shift);
    return $browser;
}

sub Parse {
    my $browser   = shift;
    my $ua_string = shift;
    my $useragent = $ua_string;
    my $version;
    delete $browser->{$_} for keys %{$browser};
    return undef unless $useragent;
    return undef if $useragent eq '-';
    $browser->{user_agent} = $useragent;
    $useragent =~ s/Opera (?=\d)/Opera\//i;

    while ($useragent =~ s/\[(\w+)\]//) {
        push @{$browser->{languages}}, $lang{$1} || $1;
        push @{$browser->{langs}}, $1;
    }

    while ($useragent =~ /\((.*?)\)/) {
        $browser->{detail} .= '; ' if defined($browser->{detail});
        $browser->{detail} .= $1;
        $useragent =~ s/\((.*?)\)//;
    }
    if (defined($browser->{detail})) {
        $browser->{properties} = [split /;\s+/, $browser->{detail}];
    }

    $browser->{useragents} = [grep /\//, split /\s+/, $useragent];

    if ($ua_string =~ /(iPhone|iPad|iPod).*?OS\s+(\d+_\d(_\d)?)/) {
        $browser->{name} = 'Safari';
        $browser->{os} = $browser->{ostype} = 'iOS';
        ($browser->{osvers} = $2) =~ s/_/./g;
        if ($useragent =~ m!(Version|CriOS)/((\d+)(\.(\d+)[\.0-9]*)?)!) {
            if ($1 eq 'CriOS') {
                $browser->{name} = 'Chrome';
            }
            $browser->{version}->{v}     = $2;
            $browser->{version}->{major} = $3;
            $browser->{version}->{minor} = $5 if defined($5) && $5 ne '';
        }
    }
    elsif ($ua_string =~ m!\((BlackBerry|BB10).*Version/([0-9\.]+)!) {
        my $version_string = $2;
        $browser->{name} = $browser->{ostype} = 'BlackBerry';
        $browser->{version}->{v} = $version_string;
        if ($version_string =~ m!^([0-9]+)(\.([0-9]+).*)?!) {
            $browser->{version}->{major} = $browser->{osvers} = $1;
            $browser->{os}               = "BlackBerry $1";
            $browser->{version}->{minor} = $3 if defined($3) && $3 ne '';
        }
    }
    elsif ($ua_string =~ m!Mozilla/5.0 \(.*?Windows.*?; rv:((\d+)\.(\d+))\) like Gecko!) {
        $browser->{name} = 'MSIE';
        $browser->{version}->{v} = $1;
        $browser->{version}->{major} = $2;
        $browser->{version}->{minor} = $3;
    } elsif ($useragent =~ m!OPR/((\d+)\.(\d+)\.\d+\.\d+)!) {
        $browser->{name}             = 'Opera';
        $browser->{version}->{v}     = $1;
        $browser->{version}->{major} = $2;
        $browser->{version}->{minor} = $3;
    } elsif ($useragent =~ m!\bVersion/((\d+)\.(\d+)\S*) Safari/!) {
        $browser->{name}             = 'Safari';
        $browser->{version}->{v}     = $1;
        $browser->{version}->{major} = $2;
        $browser->{version}->{minor} = $3;
    } elsif ($useragent =~ m!Opera/.*Version/((\d+)\.(\d+)\S*)$!) {
        $browser->{name}             = 'Opera';
        $browser->{version}->{v}     = $1;
        $browser->{version}->{major} = $2;
        $browser->{version}->{minor} = $3;
    } else {
        my $seenchrome = 0;
        for (@{$browser->{useragents}}) {
            my ($br, $ver) = split /\//;
            $br = 'Chrome' if $br eq 'CriOS';
            if ($br ne 'Safari' || not $seenchrome) {
                $browser->{name} = $br;
                $browser->{version}->{v} = $ver;
                if ($ver =~ m!^v?(\d+)\.(\d+)!) {
                    ($browser->{version}->{major}, $browser->{version}->{minor}) = ($1, $2);
                }
            }
            $seenchrome = 1 if lc($br) eq 'chrome';
            last if lc($br) eq 'iron';
            last if lc($br) eq 'lynx';
            # last if lc($br) eq 'chrome';
            last if lc($br) eq 'opera';
        }
    }

    for (@{$browser->{properties}}) {
        /compatible/i and next;

        unless (defined($browser->{name}) && (lc($browser->{name}) eq 'webtv' || lc($browser->{name}) eq 'opera')) {
            /^MSIE (.*)$/ and do {
                $browser->{name} = 'MSIE';
                $browser->{version}->{v} = $1;
                ($browser->{version}->{major},
                $browser->{version}->{minor}) = split /\./, $1, 2;
            };
        }

        m!^Edge/(([0-9]+)\.([0-9]+))! and do {
            $browser->{name} = 'Edge';
            $browser->{version}->{v} = $1;
            $browser->{version}->{major} = $2;
            $browser->{version}->{minor} = $3;
        };

        if (m!^AOL ([0-9].*)!) {
            $browser->{name} = 'AOL';
            $browser->{version}->{v} = $1;
            ($browser->{version}->{major}, $browser->{version}->{minor}) = split /\./, $browser->{version}->{v};
        }

        /^Konqueror\/([-0-9.a-z]+)/ and do {
            $browser->{name} = 'Konqueror';
            $browser->{version}->{v} = $1;
            ($browser->{version}->{major}, $browser->{version}->{minor}) = split /\./, $browser->{version}->{v};
        };

        /\bCamino\/([0-9.]+)/ and do {
            $browser->{name} = 'Camino';
            $browser->{version}->{v} = $1;
            ($browser->{version}->{major}, $browser->{version}->{minor}) = split /\./, $browser->{version}->{v}, 2;
        } and last;

        if (m!^Opera Mini/([0-9.]+)!) {
            $browser->{name} = 'Opera Mini';
            $browser->{version}->{v} = $1;
            ($browser->{version}->{major}, $browser->{version}->{minor}) = split /\./, $browser->{version}->{v};
        }

        if (/^Win/) {
            $browser->{os} = $_;
            $browser->{ostype} = 'Windows' . (/phone/i ? ' Phone' : '');
            if (/Windows NT\s*((\d+)(\.\d+)?)/ || /^WinNT((\d+)(\.\d+)?)/) {
                $browser->{ostype} = 'Windows NT';
                $version = $1;
                if ($version >= 10) {
                    $browser->{osvers} = '10';
                }
                elsif ($version >= 6.3 && $version < 7) {
                    $browser->{osvers} = '8.1';
                } elsif ($version >= 6.2) {
                    $browser->{osvers} = '8';
                } elsif ($version >= 6.1) {
                    $browser->{osvers} = '7';
                } elsif ($version >= 6.06) {
                    $browser->{osvers} = 'Server 2008';
                } elsif ($version >= 6.0) {
                    $browser->{osvers} = 'Vista';
                } elsif ($version >= 5.1) {
                    $browser->{osvers} = 'XP';
                } elsif ($version >= 5.0) {
                    $browser->{osvers} = '2000';
                } else {
                    $browser->{osvers} = $version;
                }
            }
            elsif (/Windows (?:Phone )?(\d+(\.\d+)?)/) {
                $browser->{osvers} = $1;
            } elsif (/Win(\w\w)/i) {
                $browser->{osvers} = $1;
            }
        }

        if (/^Mac/) {
            $browser->{os} = $_;
            $browser->{ostype} = 'Macintosh';
            (undef, $browser->{osvers}) = split /[ _]/, $_, 2;
        }

        if (/^PPC$/) {
            $browser->{osarc} = 'PPC';
        }

        # TODO: parsing of version and osarc doesn't always get it right. See Danish Opera test
        if (/Android\s([\.0-9]+)/ && lc($browser->{name}) ne 'edge') {
            $browser->{os}     = 'Android';
            $browser->{ostype} = 'Linux';
            $browser->{osvers} = $1;
        } elsif (/^Linux/) {
            my $lstr = $_;
            $browser->{os}     = 'Linux';
            $browser->{ostype} = 'Linux';
            if ($lstr =~ s/(i386|mips|amd64|sparc64|ppc|i686|i586|armv51|x86|x86-64|x86_64|ppc64|x64|x64_64)\b//) {
                $browser->{osarc} = $1;
            }
            if ($lstr =~ / (\d+\.\S+)/) {
                $browser->{osvers} = $1;
            }
        }

        if (/^(SunOS|Solaris)/i) {
            $browser->{os} = $_;
            $browser->{ostype} = 'Solaris';
            if (/(sun4[a-z]|i86pc)/) {
                $browser->{osarc} = $1;
            }
            if (/^SunOS\s*([0-9\.]+)/) {
                $browser->{osvers} = $1;
            }
        }

        if (/^($langRE)-/ || /^($langRE)$/) {
            my $langCode = $1;
            push(@{$browser->{languages}}, $lang{$langCode});
            push(@{$browser->{langs}}, $langCode);
        }
    }

    if (defined($browser->{name}) && exists $name_map{ $browser->{name} }) {
        $browser->{name} = $name_map{ $browser->{name} };
    }

    $browser->{name} ||= $useragent;

    if ($browser->{name} eq 'Konqueror') {
        $browser->{ostype} ||= 'Linux';
    }

    my %langs_in;

    for (@{$browser->{langs}}) {
        $langs_in{$_}++;
    }

    if (int(keys %langs_in) > 0) {
        ($browser->{lang}) = sort {$langs_in{$a} <=> $langs_in{$b}} keys %langs_in;
        $browser->{language} = $lang{$browser->{lang}} || $browser->{lang};
        # delete $browser->{language} unless $browser->{language};
    }
    return $browser;
}

sub DESTROY {
}

sub AUTOLOAD {
    my $self   = shift;
    my $method = lc($AUTOLOAD);
    $method =~ s/^.*\:\://;

    if (exists($self->{$method})) {
        return $self->{$method};
    } elsif (exists($self->{version}->{$method})) {
        return $self->{version}->{$method};
    }

    return undef;
}

__END__