javonet-nodejs-sdk 2.1.1 → 2.1.3

package/Binaries/Perl/MacOs/X64/deps/lib/perl5/HTTP/Negotiate.pm

@@ -1,528 +0,0 @@
-package HTTP::Negotiate;
-
-$VERSION = "6.01";
-sub Version { $VERSION; }
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(choose);
-
-require HTTP::Headers;
-
-$DEBUG = 0;
-
-sub choose ($;$)
-{
-    my($variants, $request) = @_;
-    my(%accept);
-
-    unless (defined $request) {
-	# Create a request object from the CGI environment variables
-	$request = HTTP::Headers->new;
-	$request->header('Accept', $ENV{HTTP_ACCEPT})
-	  if $ENV{HTTP_ACCEPT};
-	$request->header('Accept-Charset', $ENV{HTTP_ACCEPT_CHARSET})
-	  if $ENV{HTTP_ACCEPT_CHARSET};
-	$request->header('Accept-Encoding', $ENV{HTTP_ACCEPT_ENCODING})
-	  if $ENV{HTTP_ACCEPT_ENCODING};
-	$request->header('Accept-Language', $ENV{HTTP_ACCEPT_LANGUAGE})
-	  if $ENV{HTTP_ACCEPT_LANGUAGE};
-    }
-
-    # Get all Accept values from the request.  Build a hash initialized
-    # like this:
-    #
-    #   %accept = ( type =>     { 'audio/*'     => { q => 0.2, mbx => 20000 },
-    #                             'audio/basic' => { q => 1 },
-    #                           },
-    #               language => { 'no'          => { q => 1 },
-    #                           }
-    #             );
-
-    $request->scan(sub {
-	my($key, $val) = @_;
-
-	my $type;
-	if ($key =~ s/^Accept-//) {
-	    $type = lc($key);
-	}
-	elsif ($key eq "Accept") {
-	    $type = "type";
-	}
-	else {
-	    return;
-	}
-
-	$val =~ s/\s+//g;
-	my $default_q = 1;
-	for my $name (split(/,/, $val)) {
-	    my(%param, $param);
-	    if ($name =~ s/;(.*)//) {
-		for $param (split(/;/, $1)) {
-		    my ($pk, $pv) = split(/=/, $param, 2);
-		    $param{lc $pk} = $pv;
-		}
-	    }
-	    $name = lc $name;
-	    if (defined $param{'q'}) {
-		$param{'q'} = 1 if $param{'q'} > 1;
-		$param{'q'} = 0 if $param{'q'} < 0;
-	    }
-	    else {
-		$param{'q'} = $default_q;
-
-		# This makes sure that the first ones are slightly better off
-		# and therefore more likely to be chosen.
-		$default_q -= 0.0001;
-	    }
-	    $accept{$type}{$name} = \%param;
-	}
-    });
-
-    # Check if any of the variants specify a language.  We do this
-    # because it influences how we treat those without (they default to
-    # 0.5 instead of 1).
-    my $any_lang = 0;
-    for $var (@$variants) {
-	if ($var->[5]) {
-	    $any_lang = 1;
-	    last;
-	}
-    }
-
-    if ($DEBUG) {
-	print "Negotiation parameters in the request\n";
-	for $type (keys %accept) {
-	    print " $type:\n";
-	    for $name (keys %{$accept{$type}}) {
-		print "    $name\n";
-		for $pv (keys %{$accept{$type}{$name}}) {
-		    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";
-		    }
-		}
-		$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];
-}
-
-1;
-
-__END__
-
-
-=head1 NAME
-
-HTTP::Negotiate - choose a variant to serve
-
-=head1 SYNOPSIS
-
- use HTTP::Negotiate qw(choose);
-
- #  ID       QS     Content-Type   Encoding Char-Set        Lang   Size
- $variants =
-  [['var1',  1.000, 'text/html',   undef,   'iso-8859-1',   'en',   3000],
-   ['var2',  0.950, 'text/plain',  'gzip',  'us-ascii',     'no',    400],
-   ['var3',  0.3,   'image/gif',   undef,   undef,          undef, 43555],
-  ];
-
- @preferred = choose($variants, $request_headers);
- $the_one   = choose($variants);
-
-=head1 DESCRIPTION
-
-This module provides a complete implementation of the HTTP content
-negotiation algorithm specified in F<draft-ietf-http-v11-spec-00.ps>
-chapter 12.  Content negotiation allows for the selection of a
-preferred content representation based upon attributes of the
-negotiable variants and the value of the various Accept* header fields
-in the request.
-
-The variants are ordered by preference by calling the function
-choose().
-
-The first parameter is reference to an array of the variants to
-choose among.
-Each element in this array is an array with the values [$id, $qs,
-$content_type, $content_encoding, $charset, $content_language,
-$content_length] whose meanings are described
-below. The $content_encoding and $content_language can be either a
-single scalar value or an array reference if there are several values.
-
-The second optional parameter is either a HTTP::Headers or a HTTP::Request
-object which is searched for "Accept*" headers.  If this
-parameter is missing, then the accept specification is initialized
-from the CGI environment variables HTTP_ACCEPT, HTTP_ACCEPT_CHARSET,
-HTTP_ACCEPT_ENCODING and HTTP_ACCEPT_LANGUAGE.
-
-In an array context, choose() returns a list of [variant
-identifier, calculated quality, size] tuples.  The values are sorted by
-quality, highest quality first.  If the calculated quality is the same
-for two variants, then they are sorted by size (smallest first). I<E.g.>:
-
-  (['var1', 1, 2000], ['var2', 0.3, 512], ['var3', 0.3, 1024]);
-
-Note that also zero quality variants are included in the return list
-even if these should never be served to the client.
-
-In a scalar context, it returns the identifier of the variant with the
-highest score or C<undef> if none have non-zero quality.
-
-If the $HTTP::Negotiate::DEBUG variable is set to TRUE, then a lot of
-noise is generated on STDOUT during evaluation of choose().
-
-=head1 VARIANTS
-
-A variant is described by a list of the following values.  If the
-attribute does not make sense or is unknown for a variant, then use
-C<undef> instead.
-
-=over 3
-
-=item identifier
-
-This is a string that you use as the name for the variant.  This
-identifier for the preferred variants returned by choose().
-
-=item qs
-
-This is a number between 0.000 and 1.000 that describes the "source
-quality".  This is what F<draft-ietf-http-v11-spec-00.ps> says about this
-value:
-
-Source quality is measured by the content provider as representing the
-amount of degradation from the original source.  For example, a
-picture in JPEG form would have a lower qs when translated to the XBM
-format, and much lower qs when translated to an ASCII-art
-representation.  Note, however, that this is a function of the source
-- an original piece of ASCII-art may degrade in quality if it is
-captured in JPEG form.  The qs values should be assigned to each
-variant by the content provider; if no qs value has been assigned, the
-default is generally "qs=1".
-
-=item content-type
-
-This is the media type of the variant.  The media type does not
-include a charset attribute, but might contain other parameters.
-Examples are:
-
-  text/html
-  text/html;version=2.0
-  text/plain
-  image/gif
-  image/jpg
-
-=item content-encoding
-
-This is one or more content encodings that has been applied to the
-variant.  The content encoding is generally used as a modifier to the
-content media type.  The most common content encodings are:
-
-  gzip
-  compress
-
-=item content-charset
-
-This is the character set used when the variant contains text.
-The charset value should generally be C<undef> or one of these:
-
-  us-ascii
-  iso-8859-1 ... iso-8859-9
-  iso-2022-jp
-  iso-2022-jp-2
-  iso-2022-kr
-  unicode-1-1
-  unicode-1-1-utf-7
-  unicode-1-1-utf-8
-
-=item content-language
-
-This describes one or more languages that are used in the variant.
-Language is described like this in F<draft-ietf-http-v11-spec-00.ps>: A
-language is in this context a natural language spoken, written, or
-otherwise conveyed by human beings for communication of information to
-other human beings.  Computer languages are explicitly excluded.
-
-The language tags are defined by RFC 3066.  Examples
-are:
-
-  no               Norwegian
-  en               International English
-  en-US            US English
-  en-cockney
-
-=item content-length
-
-This is the number of bytes used to represent the content.
-
-=back
-
-=head1 ACCEPT HEADERS
-
-The following Accept* headers can be used for describing content
-preferences in a request (This description is an edited extract from
-F<draft-ietf-http-v11-spec-00.ps>):
-
-=over 3
-
-=item Accept
-
-This header can be used to indicate a list of media ranges which are
-acceptable as a response to the request.  The "*" character is used to
-group media types into ranges, with "*/*" indicating all media types
-and "type/*" indicating all subtypes of that type.
-
-The parameter q is used to indicate the quality factor, which
-represents the user's preference for that range of media types.  The
-parameter mbx gives the maximum acceptable size of the response
-content. The default values are: q=1 and mbx=infinity. If no Accept
-header is present, then the client accepts all media types with q=1.
-
-For example:
-
-  Accept: audio/*;q=0.2;mbx=200000, audio/basic
-
-would mean: "I prefer audio/basic (of any size), but send me any audio
-type if it is the best available after an 80% mark-down in quality and
-its size is less than 200000 bytes"
-
-
-=item Accept-Charset
-
-Used to indicate what character sets are acceptable for the response.
-The "us-ascii" character set is assumed to be acceptable for all user
-agents.  If no Accept-Charset field is given, the default is that any
-charset is acceptable.  Example:
-
-  Accept-Charset: iso-8859-1, unicode-1-1
-
-
-=item Accept-Encoding
-
-Restricts the Content-Encoding values which are acceptable in the
-response.  If no Accept-Encoding field is present, the server may
-assume that the client will accept any content encoding.  An empty
-Accept-Encoding means that no content encoding is acceptable.  Example:
-
-  Accept-Encoding: compress, gzip
-
-
-=item Accept-Language
-
-This field is similar to Accept, but restricts the set of natural
-languages that are preferred in a response.  Each language may be
-given an associated quality value which represents an estimate of the
-user's comprehension of that language.  For example:
-
-  Accept-Language: no, en-gb;q=0.8, de;q=0.55
-
-would mean: "I prefer Norwegian, but will accept British English (with
-80% comprehension) or German (with 55% comprehension).
-
-=back
-
-
-=head1 COPYRIGHT
-
-Copyright 1996,2001 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=head1 AUTHOR
-
-Gisle Aas <gisle@aas.no>
-
-=cut