UserAgent.pm

   1 package HTTP::Headers::UserAgent;
   2
   3 use strict;
   4 use Exporter;
   5 use HTTP::BrowserDetect;
   6
   7 use vars qw( $VERSION @EXPORT_OK $fh %old );
   8
   9 $VERSION = '3.00';
  10
  11 @EXPORT_OK = qw( GetPlatform );
  12
  13 %old = (
  14   irix    => 'UNIX',
  15   macos   => 'MAC',
  16   osf1    => 'UNIX',
  17   linux   => 'Linux',
  18   solaris => 'UNIX',
  19   sunos   => 'UNIX',
  20   bsdi    => 'UNIX',
  21   win16   => 'Win3x',
  22   win95   => 'Win95',
  23   win98   => 'Win98',
  24   winnt   => 'WINNT',
  25   win32   => undef,
  26   os2     => 'OS2',
  27   unknown => undef,
  28 );
  29
  30 =head1 NAME
  31
  32 HTTP::Headers::UserAgent - Class encapsulating the HTTP User-Agent header
  33
  34 =head1 SYNOPSIS
  35
  36   use HTTP::Headers::UserAgent;
  37
  38   HTTP::Headers::UserAgent->DumpFile( $fh );
  39
  40   $user_agent = new HTTP::Headers::UserAgent $ENV{HTTP_USER_AGENT};
  41
  42   $user-agent->string( $ENV{HTTP_USER_AGENT} );
  43
  44   $string = $user_agent->string;
  45
  46   $platform = $user_agent->platform;
  47
  48   $os = $user_agent->os;
  49
  50   ( $browser, $version ) = $user_agent->browser;
  51
  52   #backwards-compatibility with HTTP::Headers::UserAgent 1.00
  53   $old_platform = HTTP::Headers::UserAgent::GetPlatform $ENV{HTTP_USER_AGENT};
  54
  55 =head1 DESCRIPTION
  56
  57 The HTTP::Headers::UserAgent class represents User-Agent HTTP headers.
  58
  59 This is version 3.00 of the HTTP::Headers::UserAgent class.  It is now
  60 B<depriciated>, and the code is a wrapper around the more well-maintained
  61 HTTP::BrowserDetect module.  You are advised to switch to HTTP::BrowswerDetect.
  62 While the interface provides backward-compatibility with version 1.00, it is
  63 not based on the 1.00 code.
  64
  65 =head1 METHODS
  66
  67 =over 4
  68
  69 =item DumpFile
  70
  71 No-op compatibility method.
  72
  73 =cut
  74
  75 sub DumpFile {
  76   shift;
  77 }
  78
  79 =item new HTTP_USER_AGENT
  80
  81 Creates a new HTTP::Headers::UserAgent object.  Takes the HTTP_USER_AGENT
  82 string as a parameter.
  83
  84 =cut
  85
  86 sub new {
  87   my $proto = shift;
  88   my $class = ref($proto) || $proto;
  89   my $self = { 'bd' => new HTTP::BrowserDetect(shift) };
  90   bless( $self, $class);
  91 }
  92
  93
  94 =item string [ HTTP_USER_AGENT ]
  95
  96 If a parameter is given, sets the user-agent string.
  97
  98 Returns the user-agent as an unprocessed string.
  99
 100 =cut
 101
 102 sub string {
 103   my $self = shift;
 104   $self->{'bd'}->user_agent(@_);
 105 }
 106
 107 =item platform
 108
 109 Tries to guess the platform.  Returns ia32, ppc, alpha, hppa, mips, sparc, or
 110 unknown.
 111
 112   ia32   Intel archetecure, 32-bit (x86)
 113   ppc    PowerPC
 114   alpha  DEC (now Compaq) Alpha
 115   hppa   HP
 116   mips   SGI MIPS
 117   sparc  Sun Sparc
 118
 119 This is the only function which is not yet implemented as a wrapper around
 120 an equivalent function in HTTP::BrowserDetect.
 121
 122 =cut
 123
 124 sub platform {
 125   my $self = shift;
 126   for ( $self->{'bd'}{'user_agent'} ) {
 127     /Win/             && return "ia32";
 128     /Mac/             && return "ppc";
 129     /Linux.*86/       && return "ia32";
 130     /Linux.*alpha/    && return "alpha";
 131     /OSF/             && return "alpha";
 132     /HP-UX/           && return "hppa";
 133     /IRIX/            && return "mips";
 134     /(SunOS|Solaris)/ && return "sparc";
 135   }
 136   print $fh $self->string if $fh;
 137   "unknown";
 138 }
 139
 140 =item os
 141
 142 Tries to guess the operating system.  Returns irix, win16, win95, win98,
 143 winnt, win32 (Windows 95/98/NT/?), macos, osf1, linux, solaris, sunos, bsdi,
 144 os2, or unknown.
 145
 146 This is now a wrapper around HTTP::BrowserDetect methods.  Using
 147 HTTP::BrowserDetect natively offers a better interface to OS detection and is
 148 recommended.
 149
 150 =cut
 151
 152 sub os {
 153   my $self = shift;
 154   my $os = '';
 155   foreach my $possible ( qw(
 156     win31 win95 win98 winnt win2k winme win32 win3x win16 windows
 157     mac68k macppc mac
 158     os2
 159     sun4 sun5 suni86 sun irix
 160     linux
 161     dec bsd
 162   ) ) {
 163     $os ||= $possible if $self->{'bd'}->$possible;
 164   }
 165   $os = 'macos' if $os =~ /^mac/;
 166   $os = 'osf1' if $os =~ /^dec/;
 167   $os = 'solaris' if $os =~ /^sun(5$|i86$|$)/;
 168   $os = 'sunos' if $os eq 'sun4';
 169   $os = 'bsdi' if $os eq 'bsd';
 170   $os || 'unknown';
 171 }
 172
 173 =item browser
 174
 175 Returns a list consisting of the browser name and version.  Possible browser
 176 names are:
 177
 178 Netscape, IE, Opera, Lynx, WebTV, AOL Browser, or Unknown
 179
 180 This is now a wrapper around HTTP::BrowserDetect::browser_string
 181
 182 =cut
 183
 184 sub browser {
 185   my $self = shift;
 186   my $browser = $self->{'bd'}->browser_string();
 187   $browser = 'Unknown' unless defined $browser;
 188   $browser = 'IE' if $browser eq 'MSIE';
 189   $browser;
 190 }
 191
 192 =back
 193
 194 =head1 BACKWARDS COMPATIBILITY
 195
 196 For backwards compatibility with HTTP::Headers::UserAgent 1.00, a GetPlatform
 197 subroutine is provided.
 198
 199 =over 4
 200
 201 =item GetPlatform HTTP_USER_AGENT
 202
 203 Returns Win95, Win98, WinNT, UNIX, MAC, Win3x, OS2, Linux, or undef.
 204
 205 In some cases ( `Win32', `Windows CE' ) where HTTP::Headers::UserAgent 1.00
 206 would have returned `Win95', will return undef instead.
 207
 208 Will return `UNIX' for some cases where HTTP::Headers::UserAgent would have
 209 returned undef.
 210
 211 =cut
 212
 213 sub GetPlatform {
 214   my $string = shift;
 215   my $object = new HTTP::Headers::UserAgent $string;
 216   $old{ $object->os };
 217 }
 218
 219 =back
 220
 221 =head1 AUTHOR
 222
 223 Ivan Kohler <ivan-useragent@420.am>
 224
 225 Portions of this software were originally taken from the Bugzilla Bug
 226 Tracking system <http://www.mozilla.org/bugs/>, and are reused here with
 227 permission of the original author, Terry Weissman <terry@mozilla.org>.
 228
 229 =head1 COPYRIGHT
 230
 231 Copyright (c) 2001 Ivan Kohler.  All rights reserved.
 232 This program is free software; you can redistribute it and/or modify it
 233 under the same terms as Perl itself.
 234
 235 =head1 BUGS
 236
 237 Really you should just switch over to the more well-maintained
 238 HTTP::BrowserDetect, which this module is now just a wrapper around.
 239
 240 =head1 SEE ALSO
 241
 242 perl(1), L<HTTP::Headers>, L<HTTP::BrowserDetect>
 243
 244 =cut
 245
 246 1;
 247