Apache2-WURFLFilter
view release on metacpan or search on metacpan
lib/Apache2/WURFLFilter.pm view on Meta::CPAN
$cacheSystem->store('wurfl-conf', 'ver', 'null');
$cacheSystem->store('wurfl-conf', 'caplist', 'null');
$cacheSystem->store('wurfl-conf', 'listall', 'null');
$cacheSystem->store('wurfl-conf', 'RedirectTranscoderUrl','null');
$cacheSystem->store('wurfl-conf', 'MobileVersionUrl','null');
$cacheSystem->store('wurfl-conf', 'FullBrowserUrl','null');
$cacheSystem->store('wurfl-conf', 'ResizeImageDirectory','null');
}
if ($ENV{MOBILE_HOME}) {
&loadConfigFile("$ENV{MOBILE_HOME}/wurfl.xml");
} else {
$CommonLib->printLog("MOBILE_HOME not exist. Please set the variable MOBILE_HOME into httpd.conf");
ModPerl::Util::exit();
}
sub loadConfigFile {
my ($fileWurfl) = @_;
my $null="";
my $null2="";
my $null3="";
my $val;
my $capability;
my $r_id;
my $dummy;
#The filter
$CommonLib->printLog("Start read configuration from httpd.conf");
if ($ENV{WurflNetDownload}) {
$wurflnetdownload=$ENV{WurflNetDownload};
$CommonLib->printLog("WurflNetDownload is: $wurflnetdownload");
}
if ($ENV{DownloadWurflURL}) {
$downloadwurflurl=$ENV{DownloadWurflURL};
$CommonLib->printLog("DownloadWurflURL is: $downloadwurflurl");
}
if ($ENV{CapabilityList}) {
my @dummycapability = split(/,/, $ENV{CapabilityList});
foreach $dummy (@dummycapability) {
if ($dummy eq "all") {
$listall="true";
}
$Capability{$dummy}=$dummy;
$CommonLib->printLog("CapabilityList is: $dummy");
}
}
if ($ENV{LoadWebPatch}) {
$loadwebpatch=$ENV{LoadWebPatch};
$CommonLib->printLog("LoadWebPatch is: $loadwebpatch");
}
if ($ENV{PatchWurflNetDownload}) {
$patchwurflnetdownload=$ENV{PatchWurflNetDownload};
$CommonLib->printLog("PatchWurflNetDownload is: $patchwurflnetdownload");
}
if ($ENV{PatchWurflUrl}) {
$patchwurflurl=$ENV{PatchWurflUrl};
$CommonLib->printLog("PatchWurflUrl is: $patchwurflurl");
}
if ($ENV{CookieCacheSystem}) {
$cookiecachesystem=$ENV{CookieCacheSystem};
$CommonLib->printLog("CookieCacheSystem is: $cookiecachesystem");
}
$CommonLib->printLog("Finish loading parameter");
$CommonLib->printLog("---------------------------------------------------------------------------");
if ($wurflnetdownload eq "true") {
$CommonLib->printLog("Start process downloading WURFL.xml from $downloadwurflurl");
$CommonLib->printLog ("Test the URL");
my ($content_type, $document_length, $modified_time, $expires, $server) = head($downloadwurflurl);
if ($content_type eq "") {
$CommonLib->printLog("Couldn't get $downloadwurflurl.");
ModPerl::Util::exit();
} else {
$CommonLib->printLog("The URL is correct");
$CommonLib->printLog("The size of document wurf file: $document_length bytes");
}
if ($content_type eq 'application/zip') {
$CommonLib->printLog("The file is a zip file.");
$CommonLib->printLog ("Start downloading");
my @dummypairs = split(/\//, $downloadwurflurl);
my ($ext_zip) = $downloadwurflurl =~ /\.(\w+)$/;
my $filezip=$dummypairs[-1];
my $tmp_dir=$ENV{MOBILE_HOME};
$filezip="$tmp_dir/$filezip";
my $status = getstore ($downloadwurflurl,$filezip);
my $output="$tmp_dir/tmp_wurfl.xml";
unzip $filezip => $output
or die "unzip failed: $UnzipError\n";
#
# call parseWURFLFile
#
callparseWURFLFile($output);
} else {
$CommonLib->printLog("The file is a xml file.");
my $content = get ($downloadwurflurl);
my @rows = split(/\n/, $content);
my $row;
my $count=0;
foreach $row (@rows){
$r_id=parseWURFLFile($row,$r_id);
}
}
$CommonLib->printLog("Finish downloading WURFL from $downloadwurflurl");
} else {
if (-e "$fileWurfl") {
$CommonLib->printLog("Start loading WURFL.xml");
if (open (IN,"$fileWurfl")) {
while (<IN>) {
$r_id=parseWURFLFile($_,$r_id);
}
close IN;
} else {
$CommonLib->printLog("Error open file:$fileWurfl");
ModPerl::Util::exit();
}
} else {
lib/Apache2/WURFLFilter.pm view on Meta::CPAN
}
return %ArrayCapFoundToPass;
}
sub IdentifyUAMethod {
my ($UserAgent) = @_;
my $ind=0;
my %ArrayPM;
my $pair;
my $pair2;
my $id_find="";
my $dummy;
my $ua_toMatch;
my $near_toFind=100;
my $near_toMatch;
my %ArrayUAType=$CommonLib->GetMultipleUa($UserAgent);
foreach $pair (reverse sort { $a <=> $b } keys %ArrayUAType)
{
my $dummy=$ArrayUAType{$pair};
if ($Array_id{$dummy}) {
if ($id_find) {
my $dummy2="";
} else {
$id_find=$Array_id{$dummy};
}
}
}
return $id_find;
}
sub IdentifyPCUAMethod {
my ($UserAgent) = @_;
my $ind=0;
my $id_find="";
my $pair;
foreach $pair (%PatchArray_id)
{
if (index($UserAgent,$pair) > 0) {
$id_find=$PatchArray_id{$pair};
}
}
return $id_find;
}
sub handler {
my $f = shift;
my $capability2;
my $variabile="";
my $user_agent=$f->headers_in->{'User-Agent'}|| '';
my $x_user_agent=$f->headers_in->{'X-Device-User-Agent'}|| '';
my $query_string=$f->args;
my $docroot = $f->document_root();
my $id="";
my $location="none";
my $width_toSearch;
my $type_redirect="internal";
my $return_value;
my $dummy="";
my $variabile2="";
my %ArrayCapFound;
my $controlCookie;
my $query_img="";
$ArrayCapFound{is_transcoder}='false';
my %ArrayQuery;
my $var;
my $mobile=0;
if ($x_user_agent) {
$f->log->warn("Warn probably transcoder: $x_user_agent");
$user_agent=$x_user_agent;
}
if ($user_agent =~ m/Blackberry/i) {
$user_agent=substr($user_agent,index($user_agent,'BlackBerry'));
$mobile=1;
}
if ($user_agent =~ m/UP.link/i ) {
$user_agent=substr($user_agent,0,index($user_agent,'UP.Link') - 1);
$mobile=1;
}
my $cookie = $f->headers_in->{Cookie} || '';
$id=$CommonLib->readCookie($cookie);
if ($cacheSystem->restore( 'wurfl-ua', $user_agent )) {
#
# cookie is not empty so I try to read in memory cache on my httpd cache
#
$id=$cacheSystem->restore( 'wurfl-ua', $user_agent );
if ($cacheSystem->restore( 'wurfl-id', $id )) {
#
# I'm here only for old device
#
my @pairs = split(/&/, $cacheSystem->restore( 'wurfl-id', $id ));
my $param_tofound;
my $string_tofound;
foreach $param_tofound (@pairs) {
($string_tofound,$dummy)=split(/=/, $param_tofound);
$ArrayCapFound{$string_tofound}=$dummy;
my $upper2=uc($string_tofound);
$f->subprocess_env("AMF_$upper2" => $ArrayCapFound{$string_tofound});
}
$f->pnotes('max_image_height' => $ArrayCapFound{max_image_height});
$f->pnotes('max_image_width' => $ArrayCapFound{max_image_width});
$f->pnotes('device_claims_web_support' => $ArrayCapFound{device_claims_web_support});
$f->pnotes('is_wireless_device' => $ArrayCapFound{is_wireless_device});
$f->pnotes('is_transcoder' => $ArrayCapFound{is_transcoder});
$id=$ArrayCapFound{id};
}
} else {
if ($id eq "") {
if ($user_agent) {
my $pair;
my $lcuser_agent=lc($user_agent);
if ($mobile==0) {
foreach $pair (%MobileArray) {
if ($user_agent =~ m/$pair/i) {
$mobile=1;
}
}
if ($mobile==0) {
$id=IdentifyPCUAMethod($user_agent);
}
}
if ($id eq "") {
$id=IdentifyUAMethod($user_agent);
}
$cacheSystem->store( 'wurfl-ua', $user_agent, $id);
}
}
if ($id ne "") {
#
# device detected
#
if ($cacheSystem->restore( 'wurfl-id', $id )) {
#
# I'm here only for old device looking in cache
#
my @pairs = split(/&/, $cacheSystem->restore( 'wurfl-id', $id ));
my $param_tofound;
my $string_tofound;
foreach $param_tofound (@pairs) {
($string_tofound,$dummy)=split(/=/, $param_tofound);
$ArrayCapFound{$string_tofound}=$dummy;
my $upper2=uc($string_tofound);
$f->subprocess_env("AMF_$upper2" => $ArrayCapFound{$string_tofound});
}
$id=$ArrayCapFound{id};
} else {
%ArrayCapFound=FallBack($id);
foreach $capability2 (sort keys %ArrayCapFound) {
$variabile2="$variabile2$capability2=$ArrayCapFound{$capability2}&";
my $upper=uc($capability2);
$f->subprocess_env("AMF_$upper" => $ArrayCapFound{$capability2});
}
$variabile2="id=$id&$variabile2";
$f->subprocess_env("AMF_ID" => $id);
$cacheSystem->store( 'wurfl-id', $id, $variabile2 );
$cacheSystem->store( 'wurfl-ua', $user_agent, $id);
if ($cookiecachesystem eq "true") {
$f->err_headers_out->set('Set-Cookie' => "amf=$id; path=/;");
}
}
$f->pnotes('width' => $ArrayCapFound{max_image_width});
$f->pnotes('height' => $ArrayCapFound{max_image_height});
$f->pnotes('device_claims_web_support' => $ArrayCapFound{device_claims_web_support});
$f->pnotes('is_wireless_device' => $ArrayCapFound{is_wireless_device});
$f->pnotes('is_transcoder' => $ArrayCapFound{is_transcoder});
} else {
#
# unknown device
#
$cacheSystem->store( 'wurfl-ua', $user_agent, "device_not_found");
if ($cookiecachesystem eq "true") {
$f->err_headers_out->set('Set-Cookie' => "amf=device_not_found; path=/;");
}
}
}
$f->subprocess_env("AMF_VER" => $VERSION);
$f->subprocess_env("AMF_WURFLVER" => $WURFLVersion);
return Apache2::Const::DECLINED;
}
1;
__END__
=head1 NAME
Apache2::WURFLFilter - The module detects the mobile device and passes the WURFL capabilities on to the other web application as environment variables
=head1 SYNOPSYS
The configuration of V2.x of B<"Apache Mobile Filter"> is very simple thane V1.x, I have deprecated the intelliswitch method because I think that the filter is faster.
Add this parameter into httpd.conf file:
=over 4
=item C<PerlSetEnv CacheDirectoryStore /tmp>
=item C<PerlSetEnv CapabilityList max_image_width,j2me_midp_2_0> *
=item C<PerlSetEnv WurflNetDownload true>***
=item C<PerlSetEnv DownloadWurflURL http://downloads.sourceforge.net/wurfl/wurfl-latest.zip>****
=item C<PerlSetEnv DownloadZipFile false>
=item C<PerlSetEnv ResizeImageDirectory /transform>
=item C<PerlSetEnv LoadWebPatch true>
=item C<PerlSetEnv PatchWurflNetDownload true>
=item C<PerlSetEnv PatchWurflUrl http://wurfl.sourceforge.net/web_browsers_patch.xml>
=item C<PerlSetEnv MobileVersionUrl /cgi-bin/perl.html> ** (default is "none" that mean the filter pass through)
=item C<PerlSetEnv FullBrowserUrl http://www.google.com> ** (default is "none" that mean the filter pass through)
=item C<PerlSetEnv RedirectTranscoderUrl /transcoderpage.html> (default is "none" that mean the filter pass through)
=item C<PerlSetEnv CookieCacheSystem true> (default is false, but for production mode is suggested to set in true)
=item C<PerlModule Apache2::WURFLFilter>
=item C<PerlTransHandler +Apache2::WURFLFilter>
=back
* the field separator of each capability you want to consider in your mobile site is ",". Important you now can set ALL (default value) if you want that the filter managed all wurfl capabilities
**if you put a relative url (for example "/path") the filter done an internal redirect, if you put a url redirect with protocol (for example "http:") the filter done a classic redirect
***if this parameter is fault the filter try to read the wurfl.xml file from MOBILE_HOME path
***if you want to download directly the last version of WURFL.xml you can set the url parameter to http://downloads.sourceforge.net/wurfl/wurfl-latest.zip
****if you put to true value you can detect a little bit more device, but for strange UA the method take a lot of time
=head1 DESCRIPTION
For this configuration you need to set this parameter
=over 4
=item C<PerlSetEnv CacheDirectoryStore>: set where the AMF cache is located
=item C<ConvertImage> (boolean): activate/deactivate the adaptation of images to the device
=item C<ResizeImageDirectory>: where the new images are saved for cache system, remember this directory must be into docroot directory and also must be writeble from the server
=item C<WurflNetDownload> (boolean): if you want to download WURFL xml directly from WURFL site or from an intranet URL (good to have only single point of Wurfl access), default is set to false
=item C<DownloadWurflURL>: the url of WURFL DB to download**
=item C<CapabilityList> : is the capability value you want to pass to you site
=item C<MobileVersionUrl>: is the URL address of mobile version site *
=item C<FullBrowserUrl>: is the URL address of PC version site *
=item C<RedirectTranscoderURL>: the URL where you want to redirect the transcoder*
=item C<LoadWebPatch> (boolean): if you want to use a wurfl patch file
=item C<PatchWurflNetDownload>(boolean): if you want download the patch file
=item C<PatchWurflUrl>: the URL of the patch file (is readed ony if PatchWurflNet is setted with true)
=back
*if you put a relative url (for example "/path") the filter done an internal redirect, if you put a url redirect with protocol (for example "http:") the filter done a classic redirect. If the parameter is not set the filter is a passthrough
**if you want to download directly the last version of WURFL.xml you can set the url parameter to http://downloads.sourceforge.net/wurfl/wurfl-latest.zip
*** for more info about transcoder problem go to http://wurfl.sourceforge.net
=head1 SEE ALSO
For more details: http://www.idelfuschini.it/apache-mobile-filter-v2x.html
Mobile Demo page of the filter: http://apachemobilefilter.nogoogle.it (thanks Ivan alias sigmund)
( run in 1.307 second using v1.01-cache-2.11-cpan-6aa56a78535 )