File Coverage

blib/lib/Apache2/WurflSimple.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Apache2::WurflSimple;


use strict;
use warnings;


use Apache2::Const;
use Apache2::RequestRec;
use APR::Table;
use Apache2::Module ();
use Apache2::ServerUtil;
use Net::WURFL::ScientiaMobile;
use Net::WURFL::ScientiaMobile::Cache::Cookie;

# ABSTRACT:  module that the Wurfl Perl client to retrieve capabilities data from the Wurfl server

=pod

=head1 NAME

Apache2::WurflPro -A module that the Wurfl Perl client to retrieve capabilities data from the Wurfl server


=head1 DESCRIPTION

-A module that the Wurfl Perl client to retrieve capabilities data from the Wurfl server with a simple account

=head1 METHODS

=cut

use 5.010;
use strict;
use warnings;

our $VERSION = '0.01';

=pod

=head2 handler

The handler retrieves the user_agens and the api key.
It then checks the cache for existing data
If none is there is retrieves data from the Wurfl server
and sets the environment accordingly.

=cut


sub get_config {
	Apache2::Module::get_config('Apache2::Wurfl::Parameters', @_);
}


sub handler {
	my $r = shift;

        #get user agent
         my $headers_in = $r->headers_in;
         my $user_agent =  $headers_in->get('User-Agent');

	#get api key
	my $s = $r->server;
	my $dir_cfg = get_config($s, $r->per_dir_config);
	my $api_key = $dir_cfg->{WurflAPIKey};

	#load wurflcloud client library with cookie cache
	my $cache = Net::WURFL::ScientiaMobile::Cache::Cookie->new;
	my $scientiamobile = Net::WURFL::ScientiaMobile->new(
		api_key => $api_key,
		cache   => $cache,
	);

	#run device detection and retrieve data
	my $capabilities;
	my %env = %ENV;
	$env{'User-Agent'} = $user_agent unless $env{'User-Agent'};

	$cache->env(\%env);
	$scientiamobile->detectDevice(\%env);
	$capabilities = $scientiamobile->capabilities();

	#load capabilities into apache environment
	foreach my $key (keys %{$capabilities}) {
		my $upperkey = uc($key);
		$r->subprocess_env("WURFL_$upperkey" => $capabilities->{$key});
	}

	return Apache2::Const::OK;
}



=pod


=cut


1;