prefs results from the CPAN

Apache-LangPrefCookie

use Apache::Request;
use Apache::Cookie;
use Apache::Log ();

our $VERSION = '1.03';

sub handler {
    my $r           = Apache::Request->new(shift);
    my %cookies     = Apache::Cookie->new($r)->parse;
    my $cookie_name = $r->dir_config('LangPrefCookieName') || 'prefer-language';
    my @ua_lang_prefs;

    # $r->log->debug("Looking for cookie: \"$cookie_name\"");

    $r->header_out( 'Vary',
                    $r->header_out('Vary') ? $r->header_out('Vary') . 'cookie'
                    :                        'cookie'
        );

    # if we have no cookie, this is none of our business
    return DECLINED
      unless exists $cookies{$cookie_name}
          and my $cookie_pref_lang = $cookies{$cookie_name}->value();

    # dont parse an empty header just to get "Use of uninitialized value
    # in" warnings
    if ( defined $r->header_in("Accept-Language")
        and length $r->header_in("Accept-Language") )
    {
        @ua_lang_prefs =
          parse_accept_language_header( $r->header_in("Accept-Language") );
    }
    else {

        # RFC 2616 states: "If no Accept-Language header is present in
        # the request, the server SHOULD assume that all languages are
        # equally acceptable."  Since we are going to fool httpd into
        # thinking there is one, we respect the original demand by
        # inserting '*'.
        @ua_lang_prefs = q/*/;
    }

    # Now: unless the cookie wants a language that would be the
    # best matching anyway, rebuild the list of language-ranges
    unless ( $cookie_pref_lang eq $ua_lang_prefs[0] ) {
        my ( $qvalue, $language_ranges ) = ( 1, '' );
        map {
            if (m/^(?:\w{1,8}(?:-\w{1,8})*|\*)$/)
            {
                $language_ranges .= "$_;q=$qvalue, ";
                $qvalue *= .9;
            }
        } ( $cookie_pref_lang, @ua_lang_prefs );
        $language_ranges =~ s/,\s*$//;
        return DECLINED unless length $language_ranges;
        $r->header_in( "Accept-Language", $language_ranges );
        $r->log->debug(
"Cookie \"$cookie_name\" requested \"$cookie_pref_lang\", set \"Accept-Language: $language_ranges\""
        );
    }
    return OK;
}

t/htdocs/langprefcookie/switch.html view on Meta::CPAN

<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
<title>Switch Lang</title>
<script type="text/javascript">
function Set_Cookie( value ) {
  document.cookie = "prefer-language=" + escape( value );
}
</script>
</head>

<body>
<h1>Switch Langprefs</h1>

<a href="." onclick="Set_Cookie('it');">Italiano</a>
<a href="." onclick="Set_Cookie('de');">Deutsch</a>
<a href="." onclick="Set_Cookie('en');">English</a>
<a href="." onclick="Set_Cookie('x-klingon');">Klingon</a>
<a href="." onclick="Set_Cookie('*bogus*');">Bogus</a>
<a href="." onclick="Set_Cookie('XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX...
<hr>
<address></address>
<!-- hhmts start -->Last modified: Thu Dec 15 16:02:51 CET 2005 <!-- hhmts end -->

( run in 1.073 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )