view release on metacpan or  search on metacpan

ChooseLanguage.pm  view on Meta::CPAN

package Apache::ChooseLanguage;

######################################
#                                    #
#  Copyright (c) Nadeau Consultants  #
#  Billy Nadeau, bill@sanac.net      #
#                                    #
#  Updated: 09/11/2000               #
#  Last updated: 10/16/2002          #
#                                    #
######################################


use strict;
use CGI::Cookie ();
use Apache::Constants qw(:common);

our $VERSION = '1.02';

sub handler
{
    my $r = shift;
    my $uri = $r->uri;

    my $root = $r->dir_config('ChooseRoot');
    my $Cookie = $r->dir_config('ChooseCookie') or 0;

    return DECLINED unless( $uri eq $root or $Cookie );

    my $Browser = $r->dir_config('ChooseBrowser') or 1;
    my $Fuzzy = $r->dir_config('ChooseFuzzy') or 1;
    my $NoCache = $r->dir_config('ChooseNoCache') or 0;

    my %indexes = split /\s*(?:=>|,)\s*/s, $r->dir_config('ChooseIndexes');

    if( $Cookie )
    {
	my $language = "";
	my $setCookie = 0;
	
	while (  my ($key, $value) = each %indexes )
	{
	    if ( $uri eq $value )
	    {
		$setCookie = 1;
		$language = $key;
		last;
	    }
	}
	
	my %cookies = CGI::Cookie->parse($r->header_in('Cookie'));

	my $lang_cookie = $cookies{'LANGUAGE'}->value if defined $cookies{'LANGUAGE'};
	
	if ( $setCookie and $language ne $lang_cookie )
	{
	    my $domain = $r->dir_config('ChooseDomain')
		or warn "Apache::Choose : No domain for cookie\n";
	    my $expire = $r->dir_config('ChooseExpire') || "+1M";
	    
	    my $newcookie = CGI::Cookie->new( -name => 'LANGUAGE',
					      -value => $language,
					      -domain => $domain,
					      -path => '/',
					      -expires => $expire);
	    
	    $r->header_out( 'Set-Cookie' => $newcookie );
	    return DECLINED;
	}