initial importSTART

1 files changed, 247 insertions, 0 deletions

diff --git a/UserAgent.pm b/UserAgent.pm
new file mode 100644
index 0000000..bdda2e3
--- /dev/null
+++ b/UserAgent.pm
@@ -0,0 +1,247 @@
+package HTTP::Headers::UserAgent;
+
+use strict;
+use Exporter;
+use HTTP::BrowserDetect;
+
+use vars qw( $VERSION @EXPORT_OK $fh %old );
+
+$VERSION = '3.00';
+
+@EXPORT_OK = qw( GetPlatform );
+
+%old = (
+  irix    => 'UNIX',
+  macos   => 'MAC',
+  osf1    => 'UNIX',
+  linux   => 'Linux',
+  solaris => 'UNIX',
+  sunos   => 'UNIX',
+  bsdi    => 'UNIX',
+  win16   => 'Win3x',
+  win95   => 'Win95',
+  win98   => 'Win98',
+  winnt   => 'WINNT',
+  win32   => undef,
+  os2     => 'OS2',
+  unknown => undef,
+);
+
+=head1 NAME
+
+HTTP::Headers::UserAgent - Class encapsulating the HTTP User-Agent header
+
+=head1 SYNOPSIS
+
+  use HTTP::Headers::UserAgent;
+
+  HTTP::Headers::UserAgent->DumpFile( $fh );
+
+  $user_agent = new HTTP::Headers::UserAgent $ENV{HTTP_USER_AGENT};
+
+  $user-agent->string( $ENV{HTTP_USER_AGENT} );
+
+  $string = $user_agent->string;
+
+  $platform = $user_agent->platform;
+
+  $os = $user_agent->os;
+
+  ( $browser, $version ) = $user_agent->browser;
+
+  #backwards-compatibility with HTTP::Headers::UserAgent 1.00
+  $old_platform = HTTP::Headers::UserAgent::GetPlatform $ENV{HTTP_USER_AGENT};
+
+=head1 DESCRIPTION
+
+The HTTP::Headers::UserAgent class represents User-Agent HTTP headers.
+
+This is version 3.00 of the HTTP::Headers::UserAgent class.  It is now
+B<depriciated>, and the code is a wrapper around the more well-maintained
+HTTP::BrowserDetect module.  You are advised to switch to HTTP::BrowswerDetect.
+While the interface provides backward-compatibility with version 1.00, it is
+not based on the 1.00 code.
+
+=head1 METHODS
+
+=over 4
+
+=item DumpFile
+
+No-op compatibility method.
+
+=cut
+
+sub DumpFile {
+  shift;
+}
+
+=item new HTTP_USER_AGENT
+
+Creates a new HTTP::Headers::UserAgent object.  Takes the HTTP_USER_AGENT
+string as a parameter.
+
+=cut
+
+sub new {
+  my $proto = shift;
+  my $class = ref($proto) || $proto;
+  my $self = { 'bd' => new HTTP::BrowserDetect(shift) };
+  bless( $self, $class);
+}
+
+
+=item string [ HTTP_USER_AGENT ]
+
+If a parameter is given, sets the user-agent string.
+
+Returns the user-agent as an unprocessed string.
+
+=cut
+
+sub string {
+  my $self = shift;
+  $self->{'bd'}->user_agent(@_);
+}
+
+=item platform
+
+Tries to guess the platform.  Returns ia32, ppc, alpha, hppa, mips, sparc, or
+unknown.
+
+  ia32   Intel archetecure, 32-bit (x86)
+  ppc    PowerPC
+  alpha  DEC (now Compaq) Alpha
+  hppa   HP
+  mips   SGI MIPS
+  sparc  Sun Sparc
+
+This is the only function which is not yet implemented as a wrapper around
+an equivalent function in HTTP::BrowserDetect.
+
+=cut
+
+sub platform {
+  my $self = shift;
+  for ( $self->{'bd'}{'user_agent'} ) {
+    /Win/             && return "ia32";
+    /Mac/             && return "ppc";
+    /Linux.*86/       && return "ia32";
+    /Linux.*alpha/    && return "alpha";
+    /OSF/             && return "alpha";
+    /HP-UX/           && return "hppa";
+    /IRIX/            && return "mips";
+    /(SunOS|Solaris)/ && return "sparc";
+  }
+  print $fh $self->string if $fh;
+  "unknown";
+}
+
+=item os
+
+Tries to guess the operating system.  Returns irix, win16, win95, win98, 
+winnt, win32 (Windows 95/98/NT/?), macos, osf1, linux, solaris, sunos, bsdi,
+os2, or unknown.
+
+This is now a wrapper around HTTP::BrowserDetect methods.  Using
+HTTP::BrowserDetect natively offers a better interface to OS detection and is
+recommended.
+
+=cut
+
+sub os {
+  my $self = shift;
+  my $os = '';
+  foreach my $possible ( qw(
+    win31 win95 win98 winnt win2k winme win32 win3x win16 windows
+    mac68k macppc mac
+    os2
+    sun4 sun5 suni86 sun irix
+    linux
+    dec bsd
+  ) ) {
+    $os ||= $possible if $self->{'bd'}->$possible;
+  }
+  $os = 'macos' if $os =~ /^mac/;
+  $os = 'osf1' if $os =~ /^dec/;
+  $os = 'solaris' if $os =~ /^sun(5$|i86$|$)/;
+  $os = 'sunos' if $os eq 'sun4';
+  $os = 'bsdi' if $os eq 'bsd';
+  $os || 'unknown';
+}
+
+=item browser
+
+Returns a list consisting of the browser name and version.  Possible browser
+names are:
+
+Netscape, IE, Opera, Lynx, WebTV, AOL Browser, or Unknown
+
+This is now a wrapper around HTTP::BrowserDetect::browser_string
+
+=cut
+
+sub browser {
+  my $self = shift;
+  my $browser = $self->{'bd'}->browser_string();
+  $browser = 'Unknown' unless defined $browser;
+  $browser = 'IE' if $browser eq 'MSIE';
+  $browser;
+}
+
+=back
+
+=head1 BACKWARDS COMPATIBILITY
+
+For backwards compatibility with HTTP::Headers::UserAgent 1.00, a GetPlatform
+subroutine is provided.
+
+=over 4
+
+=item GetPlatform HTTP_USER_AGENT
+
+Returns Win95, Win98, WinNT, UNIX, MAC, Win3x, OS2, Linux, or undef.
+
+In some cases ( `Win32', `Windows CE' ) where HTTP::Headers::UserAgent 1.00
+would have returned `Win95', will return undef instead.
+
+Will return `UNIX' for some cases where HTTP::Headers::UserAgent would have
+returned undef.
+
+=cut
+
+sub GetPlatform {
+  my $string = shift;
+  my $object = new HTTP::Headers::UserAgent $string;
+  $old{ $object->os };
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-useragent@420.am>
+
+Portions of this software were originally taken from the Bugzilla Bug
+Tracking system <http://www.mozilla.org/bugs/>, and are reused here with
+permission of the original author, Terry Weissman <terry@mozilla.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001 Ivan Kohler.  All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 BUGS
+
+Really you should just switch over to the more well-maintained
+HTTP::BrowserDetect, which this module is now just a wrapper around.
+
+=head1 SEE ALSO
+
+perl(1), L<HTTP::Headers>, L<HTTP::BrowserDetect>
+
+=cut
+
+1;
+