File Coverage

blib/lib/HTTP/Headers/UserAgent.pm
Criterion Covered Total %
statement 39 54 72.2
branch 13 36 36.1
condition 3 6 50.0
subroutine 10 13 76.9
pod 7 8 87.5
total 72 117 61.5


line stmt bran cond sub pod time code
1             package HTTP::Headers::UserAgent;
2             # ABSTRACT: identify browser by parsing User-Agent string (deprecated)
3             $HTTP::Headers::UserAgent::VERSION = '3.07';
4 2     2   32322 use 5.006;
  2         8  
  2         76  
5 2     2   8 use strict;
  2         2  
  2         64  
6 2     2   7 use warnings;
  2         6  
  2         100  
7              
8             require Exporter;
9             our @ISA = qw(Exporter);
10              
11 2     2   1308 use HTTP::BrowserDetect 1.35;
  2         22117  
  2         71  
12              
13 2     2   14 use vars qw($fh);
  2         4  
  2         1218  
14              
15             our @EXPORT_OK = qw( GetPlatform );
16              
17             my %old = (
18             irix => 'UNIX',
19             macos => 'MAC',
20             osf1 => 'UNIX',
21             linux => 'Linux',
22             solaris => 'UNIX',
23             sunos => 'UNIX',
24             bsdi => 'UNIX',
25             win16 => 'Win3x',
26             win95 => 'Win95',
27             win98 => 'Win98',
28             winnt => 'WinNT',
29             winme => 'WinME',
30             win32 => undef,
31             os2 => 'OS2',
32             unknown => undef,
33             );
34              
35             =head1 NAME
36              
37             HTTP::Headers::UserAgent - identify browser by parsing User-Agent string (deprecated)
38              
39             =head1 SYNOPSIS
40              
41             use HTTP::Headers::UserAgent;
42              
43             $user_agent = HTTP::Headers::UserAgent->new( $ENV{HTTP_USER_AGENT} );
44             $browser = $user_agent->browser;
45             $version = $user_agent->version;
46             $os = $user_agent->os;
47              
48             $platform = $user_agent->platform;
49              
50             =head1 DESCRIPTION
51              
52             This module, HTTP::Headers::UserAgent, is deprecated. I suggest you use one
53             of the other modules which provide the same functionality. Check the
54             SEE ALSO section for pointers. This module is being kept on CPAN for
55             the moment, in case someone is using it, but at some point in the future
56             it will probably be removed from CPAN.
57              
58             This module is now just a wrapper around HTTP::BrowswerDetect, which is
59             still actively maintained. If you're still using this module, and have
60             a reason for not wanting to switch, please let me know, so I can either
61             help you migrate, or ensure the module continues to support your needs.
62              
63             =head1 METHODS
64              
65             =over 4
66              
67             =cut
68              
69             # was provided in previous versions, so now it's an undocumented
70             # backwards compatibility
71             sub DumpFile {
72 0     0 0 0 shift;
73             }
74              
75             =item new HTTP_USER_AGENT
76              
77             Creates a new HTTP::Headers::UserAgent object. Takes the HTTP_USER_AGENT
78             string as a parameter.
79              
80             =cut
81              
82             sub new {
83 13     13 1 1091 my $proto = shift;
84 13   33     58 my $class = ref($proto) || $proto;
85 13         47 my $self = { 'bd' => HTTP::BrowserDetect->new(shift) };
86 13         917 bless( $self, $class);
87             }
88              
89              
90             =item string [ HTTP_USER_AGENT ]
91              
92             If a parameter is given, sets the user-agent string.
93              
94             Returns the user-agent as an unprocessed string.
95              
96             =cut
97              
98             sub string {
99 0     0 1 0 my $self = shift;
100 0         0 $self->{'bd'}->user_agent(@_);
101             }
102              
103             =item platform
104              
105             Tries to guess the platform. Returns ia32, ppc, alpha, hppa, mips, sparc, or
106             unknown.
107              
108             ia32 Intel archetecure, 32-bit (x86)
109             ppc PowerPC
110             alpha DEC (now Compaq) Alpha
111             hppa HP
112             mips SGI MIPS
113             sparc Sun Sparc
114              
115             This is the only function which is not yet implemented as a wrapper around
116             an equivalent function in HTTP::BrowserDetect.
117              
118             =cut
119              
120             sub platform {
121 0     0 1 0 my $self = shift;
122 0         0 for ( $self->{'bd'}{'user_agent'} ) {
123 0 0       0 /Win/ && return "ia32";
124 0 0       0 /Mac/ && return "ppc";
125 0 0       0 /Linux.*86/ && return "ia32";
126 0 0       0 /Linux.*alpha/ && return "alpha";
127 0 0       0 /OSF/ && return "alpha";
128 0 0       0 /HP-UX/ && return "hppa";
129 0 0       0 /IRIX/ && return "mips";
130 0 0       0 /(SunOS|Solaris)/ && return "sparc";
131             }
132 0 0       0 print $fh $self->string if $fh;
133 0         0 "unknown";
134             }
135              
136             =item os
137              
138             Tries to guess the operating system. Returns irix, win16, win95, win98,
139             winnt, win32 (Windows 95/98/NT/?), macos, osf1, linux, solaris, sunos, bsdi,
140             os2, or unknown.
141              
142             This is now a wrapper around HTTP::BrowserDetect methods. Using
143             HTTP::BrowserDetect natively offers a better interface to OS detection and is
144             recommended.
145              
146             =cut
147              
148             sub os {
149 13     13 1 320 my $self = shift;
150 13         17 my $os = '';
151 13         27 foreach my $possible ( qw(
152             win31 win95 win98 winnt win2k winme win32 win3x win16 windows
153             mac68k macppc mac
154             os2
155             sun4 sun5 suni86 sun irix
156             linux
157             dec bsd
158             ) ) {
159 286 100 66     2314 $os ||= $possible if $self->{'bd'}->$possible();
160             }
161 13 100       119 $os = 'macos' if $os =~ /^mac/;
162 13 100       35 $os = 'osf1' if $os =~ /^dec/;
163 13 50       27 $os = 'solaris' if $os =~ /^sun(5$|i86$|$)/;
164 13 50       29 $os = 'sunos' if $os eq 'sun4';
165 13 50       31 $os = 'bsdi' if $os eq 'bsd';
166 13 50       112 $os || 'unknown';
167             }
168              
169             =item browser
170              
171             Returns the name of the browser, or 'Unknown'.
172              
173             This is now a wrapper around HTTP::BrowserDetect::browser_string
174              
175             In previous versions of this module, the documentation said that this
176             method return a list with agent name and version. But it never did,
177             it jusr returned the browser name.
178              
179             =cut
180              
181             sub browser {
182 5     5 1 38 my $self = shift;
183 5         20 my $browser = $self->{'bd'}->browser_string();
184 5 50       88 $browser = 'Unknown' unless defined $browser;
185 5 100       13 $browser = 'IE' if $browser eq 'MSIE';
186 5         12 $browser;
187             }
188              
189             =item version
190              
191             Returns the version of the browser, as a floating-point number.
192             Note: this means that version strings which aren't valid floating
193             point numbers won't be recognised.
194              
195             This method is just a wrapper around the C method
196             in HTTP::BrowserDetect.
197              
198             =cut
199              
200             sub version
201             {
202 5     5 1 13 my $self = shift;
203 5         12 return $self->{'bd'}->public_version();
204             }
205              
206             =back
207              
208             =head1 BACKWARDS COMPATIBILITY
209              
210             For backwards compatibility with HTTP::Headers::UserAgent 1.00, a GetPlatform
211             subroutine is provided.
212              
213             =over 4
214              
215             =item GetPlatform HTTP_USER_AGENT
216              
217             Returns Win95, Win98, WinNT, UNIX, MAC, Win3x, OS2, Linux, or undef.
218              
219             In some cases ( `Win32', `Windows CE' ) where HTTP::Headers::UserAgent 1.00
220             would have returned `Win95', will return undef instead.
221              
222             Will return `UNIX' for some cases where HTTP::Headers::UserAgent would have
223             returned undef.
224              
225             =cut
226              
227             sub GetPlatform {
228 8     8 1 2377 my $string = shift;
229 8         31 my $object = HTTP::Headers::UserAgent->new($string);
230 8         35 $old{ $object->os };
231             }
232              
233             =back
234              
235             =head1 SEE ALSO
236              
237             I have written a L of all CPAN modules for parsing the User-Agent string.
238             If you have a specific need, it may be worth reading the review, to find
239             the best match.
240              
241             In brief though, I would recommend you start off with one of the following
242             modules:
243              
244             =over
245              
246             =item HTML::ParseBrowser
247              
248             Has best overall coverage of different browsers and other user agents.
249              
250             =item HTTP::UserAgentString::Parser
251              
252             Also has good coverage, but is much faster than the other modules,
253             so if performance is important as well, you might prefer this module.
254              
255             =item HTTP::BrowserDetect
256              
257             Poorest coverage of the three modules listed here, and doesn't do well at
258             recognising version numbers. It's the best module for detecting whether
259             a given agent is a robot/crawler though.
260              
261             =back
262              
263             =head1 AUTHOR
264              
265             This module is now maintained by Neil Bowers .
266              
267             The previous maintainer, who wrote this version, was Ivan Kohler.
268              
269             Portions of this software were originally taken from the Bugzilla Bug
270             Tracking system , and are reused here with
271             permission of the original author, Terry Weissman .
272              
273             =head1 COPYRIGHT
274              
275             Copyright (c) 2001 Ivan Kohler. All rights reserved.
276             This program is free software; you can redistribute it and/or modify it
277             under the same terms as Perl itself.
278              
279             =cut
280              
281             1;
282