&uri_escaped
&a_href &a_href_cc
&vskip
- &img ¢erimg &rightimg
+ &img ¢erimg &rightimg &leftimg
$W
&input_hidden_persistents
&escapeHTML
do { $W->{$_}=1 if !defined $W->{$_}; } for "footer_delimit";
do { $W->{$_}=1 if !defined $W->{$_}; } for "footer_ids";
do { $W->{$_}=1 if !defined $W->{$_}; } for "indexme";
- do { $W->{$_}="" if !defined $W->{$_}; } for "head";
do { $W->{$_}="" if !defined $W->{$_}; } for "body_attr";
do { $W->{$_}="en-US" if !defined $W->{$_}; } for "language";
else
{ delete $W->{"have_ent"}; }
if (!defined $W->{"have_ent"} && $W->{"r"}->method() eq "GET") {
- $W->{"head"}.='<meta http-equiv="Refresh" content="0; URL='
+ $W->{"head_push"}='<meta http-equiv="Refresh" content="0; URL='
.escapeHTML("http://".$W->{"web_hostname"}."/".($W->{"r"}->uri()=~m#^/*(.*)$#)[0]
."?".($_ || "detect_ent_glue=1").'&have_ent=detect')
.'" />'."\n";
# as it does not look as registered, at least according to: MIME::Types $VERSION 1.15
# "application/javascript" so far standardized till 2005-12-08 by:
# http://www.ietf.org/internet-drafts/draft-hoehrmann-script-types-03.txt
- $W->{"head"}.='<script type="application/javascript" src="'.uri_escaped(path_web('/My/HaveJS.pm')).'"></script>'."\n";
+ $W->{"head_push"}='<script type="application/javascript" src="'.uri_escaped(path_web('/My/HaveJS.pm')).'"></script>'."\n";
}
# Required by &_args_check below.
{
my($method)=@_;
- return q{enctype="application/x-www-form-urlencoded" accept-charset="us-ascii utf-8"} if $method eq "post";
- return q{accept-charset="us-ascii utf-8"} if $method eq "get";
+ my $r=q{method="}.$method.q{"};
+ return $r." ".q{enctype="application/x-www-form-urlencoded" accept-charset="us-ascii utf-8"} if $method eq "post";
+ return $r." ". q{accept-charset="us-ascii utf-8"} if $method eq "get";
cluck "Undefined method: $method";
- return ""
+ return $r;
}
sub merge_post_args($)
# Never update the package list while we examine it!
$packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1;
- my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}};
+ # Dump the whole packages stack or just the primary one?
+ #my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}};
+ my $packages_used=[$W->{"__PACKAGE__"}];
+
if ($W->{"footer_ids"}) {
Wprint '<p class="cvs-id">';
Wprint join("<br />\n",map({ my $package=$_;
if (!defined $contents) {
$contents=$in;
$contents=File::Basename::basename($contents) if $args{"basename"};
+ $contents=~s/^mailto:([-.\w]+@[-.\w]+)$/$1/;
$contents=escapeHTML($contents);
}
$contents=~s#<a\b[^>]*>##gi;
return $best;
}
+# FIXME: Use for "content-type": MIME::Types
my @img_variants=(
- { "id"=>"png","qs"=>0.9,"content-type"=>"image/png" },
- { "id"=>"gif","qs"=>0.7,"content-type"=>"image/gif" },
- );
-my $img_variants_re='[.](?:'.join('|',"jpeg",map(($_->{"id"}),@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)
my $uri=in_to_uri_abs $in;
my $path_abs_disk=path_abs_disk $uri,%args,"uri_as_in"=>1,"register"=>0;
- # Known image extension?
- return path_web($uri,%args,"uri_as_in"=>1),$path_abs_disk if $uri->path()=~m#$img_variants_re#o;
-
- my @nego_variants;
- for my $var (@img_variants) {
- my $path_abs_disk_variant=$path_abs_disk.".".$var->{"id"};
- path_abs_disk_register($path_abs_disk_variant);
- __PACKAGE__->make_file($path_abs_disk_variant);
- push @nego_variants,negotiate_variant(
- %$var,
- "size"=>(stat $path_abs_disk_variant)[7],
- );
+ 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);
}
- my $ext=__PACKAGE__->Negotiate_choose(\@nego_variants);
- $uri->path($uri->path().".$ext");
+ my $uri_path=$uri->path();
+ $uri_path=~s/\Q.$ext_orig\E$/.$ext/ or cluck;
+ $uri->path($uri_path);
return path_web($uri,%args,"uri_as_in"=>1),path_abs_disk($uri,%args,"uri_as_in"=>1);
}
return $r;
}
+# Optional: Provide 'text' as 1==@args_img item.
sub rightimg
{
my($text,@args_img)=@_;
# <col width="@{[ (!$W->{"browser"}->ie() ? "0*" : "10%" ) ]}" />
# causes whole invisible projects in: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.10) Gecko/20050719 Galeon/1.3.21
return <<"HERE";
-<table border="0" width="100%">
+<table border="0" width="100%" class="textimg">
<tr>
<td align="left">
@{[ $text ]}
</td>
+ <td> </td>
<td align="right">
- @{[ &{\&img}(@args_img) ]}
+ @{[ 1==@args_img ? $args_img[0] : &{\&img}(@args_img) ]}
+ </td>
+ </tr>
+</table>
+HERE
+}
+
+# Optional: Provide 'text' as 1==@args_img item.
+sub leftimg
+{
+my($text,@args_img)=@_;
+
+ # FIXME: Workaround bug of 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)':
+ # <col width="@{[ (!$W->{"browser"}->ie() ? "0*" : "10%" ) ]}" />
+ # <col width="@{[ (!$W->{"browser"}->ie() ? "1*" : "90%" ) ]}" />
+ # causes whole invisible projects in: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.10) Gecko/20050719 Galeon/1.3.21
+ return <<"HERE";
+<table border="0" width="100%">
+ <tr>
+ <td align="center">
+ @{[ 1==@args_img ? $args_img[0] : &{\&img}(@args_img) ]}
+ </td>
+ <td> </td>
+ <td align="left">
+ @{[ $text ]}
</td>
</tr>
</table>
HERE
}
if ($W->{"css_inherit"}) {
- # Do not: <script />
- # as at least Lynx inhibits any further HTML output.
- # Do not: text/javascript
- # as it does not look as registered, at least according to: MIME::Types $VERSION 1.15
- # "application/javascript" so far standardized till 2005-12-08 by:
- # http://www.ietf.org/internet-drafts/draft-hoehrmann-script-types-03.txt
- Wprint <<"HERE";
-<script type="application/javascript" src="@{[ uri_escaped(path_web('/My/css_inherit.js')) ]}"></script>
-HERE
+ $W->{"js_push"}="/My/css_inherit.js";
}
}
+ for my $js (@{$W->{"js_push"}}) {
+ # Do not: <script />
+ # as at least Lynx inhibits any further HTML output.
+ # Do not: text/javascript
+ # as it does not look as registered, at least according to: MIME::Types $VERSION 1.15
+ # "application/javascript" so far standardized till 2005-12-08 by:
+ # http://www.ietf.org/internet-drafts/draft-hoehrmann-script-types-03.txt
+ Wprint <<"HERE";
+<script type="application/javascript" src="@{[ uri_escaped(path_web $js) ]}"></script>
+<script type="text/javascript" src="@{[ uri_escaped(path_web $js) ]}"></script>
+HERE
+ }
Wprint '<meta name="robots" content="'.($W->{"indexme"} ? "" : "no" ).'index,follow" />'."\n";
- Wprint $W->{"head"};
+ for my $head (@{$W->{"head_push"}}) {
+ $head=&{$head}() if "CODE" eq ref $head;
+ Wprint $head;
+ }
for my $type (qw(prev next index contents start up)) {
do { Wprint '<link rel="'.$type.'" href="'.uri_escaped(path_web $_).'" />'."\n" if $_; }
for ($W->{"rel_$type"});
git://git.jankratochvil.net / MyWeb.git / commitdiff