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

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

page 3 of 6



		    }
		}
		$q = $accept{'language'}{$selected}{'q'} if $selected;

		# If none of the variant's content language tags or
		# tag prefixes are listed in the provided
		# Accept-Language field, then the value assigned
		# is "ql=0.001"
		$q = 0.001 unless defined $q;
	    }
	    $ql = $q;
	}
	else {
	    $ql = 0.5 if $any_lang && exists $accept{'language'};
	}

	my $q   = 1;
	my $mbx = undef;
	# If no Accept field is given, then the value assigned is "q=1".
	# If at least one listed media range matches the variant's media
	# type, then the "q" parameter value assigned to the most specific
	# of those matched is used (e.g. "text/html;version=3.0" is more
	# specific than "text/html", which is more specific than "text/*",
	# which in turn is more specific than "*/*"). If not media range
	# in the provided Accept field matches the variant's media type,
	# then the value assigned is "q=0".
	if (exists $accept{'type'} && $ct) {
	    # First we clean up our content-type
	    $ct =~ s/\s+//g;
	    my $params = "";
	    $params = $1 if $ct =~ s/;(.*)//;
	    my($type, $subtype) = split("/", $ct, 2);
	    my %param = ();
	    for $param (split(/;/, $params)) {
		my($pk,$pv) = split(/=/, $param, 2);
		$param{$pk} = $pv;
	    }

	    my $sel_q = undef;
	    my $sel_mbx = undef;
	    my $sel_specificness = 0;

	    ACCEPT_TYPE:
	    for $at (keys %{ $accept{'type'} }) {
		print "Consider $at...\n" if $DEBUG;
		my($at_type, $at_subtype) = split("/", $at, 2);
		# Is it a match on the type
		next if $at_type    ne '*' && $at_type    ne $type;
		next if $at_subtype ne '*' && $at_subtype ne $subtype;
		my $specificness = 0;
		$specificness++ if $at_type ne '*';
		$specificness++ if $at_subtype ne '*';
		# Let's see if content-type parameters also match
		while (($pk, $pv) = each %param) {
		    print "Check if $pk = $pv is true\n" if $DEBUG;
		    next unless exists $accept{'type'}{$at}{$pk};
		    next ACCEPT_TYPE
		      unless $accept{'type'}{$at}{$pk} eq $pv;
		    print "yes it is!!\n" if $DEBUG;
		    $specificness++;
		}
		print "Hurray, type match with specificness = $specificness\n"
		  if $DEBUG;

		if (!defined($sel_q) || $sel_specificness < $specificness) {
		    $sel_q   = $accept{'type'}{$at}{'q'};
		    $sel_mbx = $accept{'type'}{$at}{'mbx'};
		    $sel_specificness = $specificness;
		}
	    }
	    $q   = $sel_q || 0;
	    $mbx = $sel_mbx;
	}

	my $Q;
	if (!defined($mbx) || $mbx >= $bs) {
	    $Q = $qs * $qe * $qc * $ql * $q;
	}
	else {
	    $Q = 0;
	    print "Variant's size is too large ==> Q=0\n" if $DEBUG;
	}

	if ($DEBUG) {
	    $mbx = "undef" unless defined $mbx;
	    printf "Q=%.4f", $Q;
	    print "  (q=$q, mbx=$mbx, qe=$qe, qc=$qc, ql=$ql, qs=$qs)\n";
	}

	push(@Q, [$id, $Q, $bs]);
    }


    @Q = sort { $b->[1] <=> $a->[1] || $a->[2] <=> $b->[2] } @Q;

    return @Q if wantarray;
    return undef unless @Q;
    return undef if $Q[0][1] == 0;
    $Q[0][0];
}
=3=

1|2| < PREV = PAGE 3 = NEXT > |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.00624108 wallclock secs ( 0.00 usr + 0.01 sys = 0.01 CPU)