File Coverage

blib/lib/Parse/HTTP/UserAgent/Base/Accessors.pm

Criterion	Covered	Total	%
statement	56	60	93.3
branch	5	6	83.3
condition	6	10	60.0
subroutine	16	18	88.8
pod	2	2	100.0
total	85	96	88.5

package Parse::HTTP::UserAgent::Base::Accessors;
$Parse::HTTP::UserAgent::Base::Accessors::VERSION = '0.42';
use strict;
use warnings;
use Parse::HTTP::UserAgent::Constants qw(:all);

BEGIN {
    my @simple = qw(
        device
        generic
        lang
        mobile
        name
        original_name
        original_version
        os
        parser
        robot
        strength
        tablet
        touch
        unknown
        wap
    );

    my @multi = qw(
        mozilla
        extras
        dotnet
    );

    no strict qw(refs); ## no critic (TestingAndDebugging::ProhibitNoStrict)
    foreach my $name ( @simple ) {
        my $id = 'UA_' . uc $name;
        $id = __PACKAGE__->$id();
        *{ $name } = sub { return shift->[$id] || q{} };
    }

    foreach my $name ( @multi ) {
        my $id = 'UA_' . uc $name;
        $id = __PACKAGE__->$id();
        *{ $name } = sub {
            my $self = shift;
            return +() if ! $self->[ $id ];
            my @rv = @{ $self->[ $id ] };
            return wantarray ? @rv : $rv[0];
        };
    }
}

sub version {
    my $self = shift;
    my $type = shift || q{};
    return $self->[ $type eq 'raw' ? UA_VERSION_RAW : UA_VERSION ] || 0;
}

sub toolkit {
    my $self = shift;
    return Parse::HTTP::UserAgent::Base::Accessors::toolkit->new(
                $self->[UA_TOOLKIT]
            );
}

package
Parse::HTTP::UserAgent::Base::Accessors::toolkit;
use strict;
use warnings;
use overload '""',    => 'name',
             '0+',    => 'version',
             fallback => 1,
;
use constant ID_NAME        => 0;
use constant ID_VERSION_RAW => 1;
use constant ID_VERSION     => 2;

sub new {
    my($class, $tk) = @_;
    return bless [ $tk ? @{ $tk } : (undef) x 3 ], $class;
}

sub name {
    return shift->[ID_NAME];
}

sub version {
    my $self = shift;
    my $type = shift || q{};
    return $self->[ $type eq 'raw' ? ID_VERSION_RAW : ID_VERSION ] || 0;
}

1;

__END__