PROXY  WHOIS  RQUOTE  TEXTS  SOFT  FOREX  BBOARD
 Music  Philosophy  Code  Literature  Russian

= ROOT|Technical|Code_Examples|Perl|site_perl|HTTP|Negotiate.pm =

page 2 of 6



		    print "      $pv = $accept{$type}{$name}{$pv}\n";
		}
	    }
	}
    }

    my @Q = ();  # This is where we collect the results of the
		 # quality calculations

    # Calculate quality for all the variants that are available.
    for (@$variants) {
	my($id, $qs, $ct, $enc, $cs, $lang, $bs) = @$_;
	$qs = 1 unless defined $qs;
        $ct = '' unless defined $ct;
	$bs = 0 unless defined $bs;
	$lang = lc($lang) if $lang; # lg tags are always case-insensitive
	if ($DEBUG) {
	    print "\nEvaluating $id (ct='$ct')\n";
	    printf "  qs   = %.3f\n", $qs;
	    print  "  enc  = $enc\n"  if $enc && !ref($enc);
	    print  "  enc  = @$enc\n" if $enc && ref($enc);
	    print  "  cs   = $cs\n"   if $cs;
	    print  "  lang = $lang\n" if $lang;
	    print  "  bs   = $bs\n"   if $bs;
	}

	# Calculate encoding quality
	my $qe = 1;
	# If the variant has no assigned Content-Encoding, or if no
	# Accept-Encoding field is present, then the value assigned
	# is "qe=1".  If *all* of the variant's content encodings
	# are listed in the Accept-Encoding field, then the value
	# assigned is "qw=1".  If *any* of the variant's content
	# encodings are not listed in the provided Accept-Encoding
	# field, then the value assigned is "qe=0"
	if (exists $accept{'encoding'} && $enc) {
	    my @enc = ref($enc) ? @$enc : ($enc);
	    for (@enc) {
		print "Is encoding $_ accepted? " if $DEBUG;
		unless(exists $accept{'encoding'}{$_}) {
		    print "no\n" if $DEBUG;
		    $qe = 0;
		    last;
		}
		else {
		    print "yes\n" if $DEBUG;
		}
	    }
	}

	# Calculate charset quality
	my $qc  = 1;
	# If the variant's media-type has no charset parameter,
	# or the variant's charset is US-ASCII, or if no Accept-Charset
	# field is present, then the value assigned is "qc=1".  If the
	# variant's charset is listed in the Accept-Charset field,
	# then the value assigned is "qc=1.  Otherwise, if the variant's
	# charset is not listed in the provided Accept-Encoding field,
	# then the value assigned is "qc=0".
	if (exists $accept{'charset'} && $cs && $cs ne 'us-ascii' ) {
	    $qc = 0 unless $accept{'charset'}{$cs};
	}

	# Calculate language quality
	my $ql  = 1;
	if ($lang && exists $accept{'language'}) {
	    my @lang = ref($lang) ? @$lang : ($lang);
	    # If any of the variant's content languages are listed
	    # in the Accept-Language field, the the value assigned is
	    # the largest of the "q" parameter values for those language
	    # tags.
	    my $q = undef;
	    for (@lang) {
		next unless exists $accept{'language'}{$_};
		my $this_q = $accept{'language'}{$_}{'q'};
		$q = $this_q unless defined $q;
		$q = $this_q if $this_q > $q;
	    }
	    if(defined $q) {
	        $DEBUG and print " -- Exact language match at q=$q\n";
	    }
	    else {
		# If there was no exact match and at least one of
		# the Accept-Language field values is a complete
		# subtag prefix of the content language tag(s), then
		# the "q" parameter value of the largest matching
		# prefix is used.
		$DEBUG and print " -- No exact language match\n";
		my $selected = undef;
		for $al (keys %{ $accept{'language'} }) {
		    if (index($al, "$lang-") == 0) {
		        # $lang starting with $al isn't enough, or else
		        #  Accept-Language: hu (Hungarian) would seem
		        #  to accept a document in hup (Hupa)
		        $DEBUG and print " -- $al ISA $lang\n";
			$selected = $al unless defined $selected;
			$selected = $al if length($al) > length($selected);
		    }
		    else {
		        $DEBUG and print " -- $lang  isn't a $al\n";
=2=

1| < PREV = PAGE 2 = NEXT > |3|4|5|6

UP TO ROOT | UP TO DIR | TO FIRST PAGE

Google
 


E-mail Facebook Google Digg del.icio.us BlinkList Fark Furl Ma.gnolia Netscape NewsVine Reddit Slashdot Spurl StumbleUpon Technorati YahooMyWeb LiveJournal Blogmarks TwitThis Live News2.ru BobrDobr.ru Memori.ru MoeMesto.ru

0.023005 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)