- my $file_base_disk;
- my $file_base_uri;
- if ($file_base!~m#^/#) {
- $file_base_disk=$file_base_uri=$file_base;
- }
- else {
- $file_base_disk=top_dir_disk().$file_base;
- $file_base_uri=top_dir($file_base);
- }
-
- my @nego_variants;
- for my $var (@img_variants) {
- my $file=$file_base_disk.".".$var->{"id"};
- # TODO: Somehow quickly check dependencies?
- make('make -s --no-print-directory'
- .' -C '."'".File::Basename::dirname($file)."' '".File::Basename::basename($file)."'")
- if !-f $file;
- push @nego_variants,negotiate_variant(
- %$var,
- "size"=>(stat $file)[7],
- );
+# Input: $self is required!
+# Input: Put the fallback variant as the first one.
+# Returns: always only scalar!
+sub Negotiate_choose($$)
+{
+my($self,$variants)=@_;
+
+ my $best=HTTP::Negotiate::choose($variants,
+ # Do not: $W->{"r"}
+ # to prevent: Can't locate object method "scan" via package "Apache2::RequestRec" at HTTP/Negotiate.pm line 84.
+ # Do not: $W->{"r"}->headers_in()
+ # to prevent: Can't locate object method "scan" via package "APR::Table" at HTTP/Negotiate.pm line 84.
+ # Do not: HTTP::Headers->new($W->{"r"}->headers_in());
+ # to prevent empty result or even: Odd number of elements in anonymous hash
+ $self->http_headers_in_for(qw(
+ Accept
+ Accept-Charset
+ Accept-Encoding
+ Accept-Language
+ )));
+ $best||=$variants->[0][0]; # $variants->[0]{"id"}; &HTTP::Negotiate::choose failed?
+ return $best;
+}
+
+# FIXME: Use for "content-type": MIME::Types
+my @img_variants=(
+ { "id"=>"svg","qs"=>0.9,"content-type"=>"image/svg+xml" },
+ { "id"=>"png","qs"=>0.8,"content-type"=>"image/png" },
+ { "id"=>"gif","qs"=>0.7,"content-type"=>"image/gif" },
+ # Do not prefer these to avoid fedding them for '*/*' browsers.
+ { "id"=>"dia","qs"=>0.6,"content-type"=>"application/x-dia-diagram" },
+ { "id"=>"fig","qs"=>0.6,"content-type"=>"image/x-xfig" },
+ { "id"=>"fig","qs"=>0.6,"content-type"=>"application/x-xfig" },
+ { "id"=>"sxd","qs"=>0.6,"content-type"=>"application/vnd.sun.xml.draw" },
+ { "id"=>"sxi","qs"=>0.6,"content-type"=>"application/vnd.sun.xml.impress" },
+ );
+# Unsupported by Image::Size 2.992: sxd sxi dia
+# Supported by Image::Size 2.992: fig png gif jpeg
+# Expensive by Image::Size 2.992: svg
+my %img_map=(
+ "svg" =>[qw(png gif)], # svg
+ "png" =>[qw(png gif)],
+ "jpeg"=>[qw(jpeg)],
+ "dia" =>[qw(png gif)], # svg
+ "fig" =>[qw(fig png gif)],
+ "sxd" =>[qw(png gif)],
+ "sxi" =>[qw(png gif)],
+ );
+
+# Returns: ($path_web,$path_abs_disk)
+# URI path segments support ignored here. Where it is used? (';' path segment options)
+sub _img_src($%)
+{
+my($in,%args)=@_;
+
+ cluck if !uri_is_local $in;
+ my $uri=in_to_uri_abs $in;
+ my $path_abs_disk=path_abs_disk $uri,%args,"uri_as_in"=>1,"register"=>0;
+
+ cluck "Not exists image path_abs_disk: $path_abs_disk" if !-r $path_abs_disk;
+ my($path_abs_disk_base,$ext_orig)=($path_abs_disk=~/^(.*)[.](\w+)$/) or cluck;
+ my $map_arrayref=$img_map{$ext_orig} or cluck;
+
+ my $ext=$ext_orig;
+ if (1!=@$map_arrayref) {
+ my @nego_variants;
+ for my $ext (@$map_arrayref) {
+ my $path_abs_disk_variant=$path_abs_disk_base.".".$ext;
+ path_abs_disk_register($path_abs_disk_variant);
+ __PACKAGE__->make_file($path_abs_disk_variant);
+ for my $var (@img_variants) {
+ next if $var->{"id"} ne $ext;
+ push @nego_variants,negotiate_variant(
+ %$var,
+ "size"=>(stat $path_abs_disk_variant)[7],
+ );
+ }
+ }
+ $ext=__PACKAGE__->Negotiate_choose(\@nego_variants);