cgi-bin/LJ/WURFL.pm

   1 package LJ::WURFL;
   2 use strict;
   3
   4 use Storable qw(retrieve);
   5
   6 sub new {
   7         my $class = shift;
   8         return bless {}, $class;
   9 }
  10
  11 sub load {
  12         my ($self, $file) = @_;
  13
  14         my $retr = eval { retrieve($file) };
  15     if ($@) {
  16         warn $@;
  17         return 0;
  18     }
  19
  20         if ($retr->{'wireless_devices'} && $retr->{'generic_devices'}) {
  21             my %wireless_devices = map { $_ => $_ } @{$retr->{'wireless_devices'}};
  22             my %generic_devices =  map { $_ => $_ } @{$retr->{'generic_devices'}};
  23
  24             $self->{'wireless_devices'} = \%wireless_devices;
  25             $self->{'generic_devices'} =  \%generic_devices;
  26
  27         return $self;
  28     } else {
  29         return 0;
  30     }
  31 }
  32
  33 sub is_mobile {
  34         my $self = shift;
  35         my $ua = shift;
  36
  37     while (length $ua) {
  38         return 0 if $self->{'generic_devices'}->{$ua};
  39         return 1 if $self->{'wireless_devices'}->{$ua};
  40         last unless $ua =~ /\//;
  41         $ua =~ s/^(.+)\/(.*)$/$1/;
  42     }
  43
  44         return 0;
  45 }
  46
  47 1;