1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
package Parse::HTTP::UserAgent::Base::Accessors;
$Parse::HTTP::UserAgent::Base::Accessors::VERSION = '0.43';
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__
=pod
=encoding UTF-8
=head1 NAME
Parse::HTTP::UserAgent::Base::Accessors - Available accessors
=head1 VERSION
version 0.43
=head1 SYNOPSIS
use Parse::HTTP::UserAgent;
my $ua = Parse::HTTP::UserAgent->new( $str );
die "Unable to parse!" if $ua->unknown;
print $ua->name;
print $ua->version;
print $ua->os;
=head1 DESCRIPTION
Ther methods can be used to access the various parts of the parsed structure.
=head1 DEPRECATION NOTICE
This module is B<DEPRECATED>. Please use L<HTTP::BrowserDetect> instead.
=head1 ACCESSORS
The parts of the parsed structure can be accessed using these methods:
=head2 device
=head2 dotnet
=head2 extras
=head2 generic
=head2 lang
=head2 mobile
=head2 mozilla
=head2 name
=head2 original_name
=head2 original_version
=head2 os
=head2 parser
=head2 robot
=head2 strength
=head2 tablet
=head2 touch
=head2 toolkit
=head2 unknown
=head2 version
=head2 wap
=head1 SEE ALSO
L<Parse::HTTP::UserAgent>.
=head1 AUTHOR
Burak Gursoy
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2009 by Burak Gursoy.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
