);
our @ISA=qw(Tie::Handle Exporter);
+my %packages_used_hash;
+my %packages_used_array;
+
BEGIN
{
use Carp qw(cluck confess);
for my $target ($class,__PACKAGE__) {
for my $caller (keys(%callers)) {
next if $caller eq $target;
- next if $W->{'packages_used%'}{$caller}{$target}++;
- push @{$W->{'packages_used@'}{$caller}},$target;
+ next if $packages_used_hash{$caller}{$target}++;
+ push @{$packages_used_array{$caller}},$target;
}
}
eval { CORE::require "$file"; } or confess $@;
# I do not know why.
use POSIX qw(strftime);
use Tie::Handle;
-use Apache2::Const qw(HTTP_MOVED_TEMPORARILY);
+use Apache2::Const qw(HTTP_MOVED_TEMPORARILY OK);
use URI;
use URI::QueryParam;
use Cwd;
# $W->{"footer_passed"}
# %{$W->{"headers"}}
# %{$W->{"headers_lc"}} # maps lc($headers_key)=>$headers_key
- # @{$W->{'packages_used@'}{callers...}}
- # %{$W->{'packages_used%'}{callers...}}
# %{$W->{"args"}}
+sub cleanup($)
+{
+my($apache_request)=@_;
+
+ # Sanity protection.
+ $W=undef();
+ return OK;
+}
+
sub init ($%)
{
my($class,%args)=@_;
Wuse 'WebConfig';
Wrequire 'My::Hash::Sub';
- my $packages_used_array_save=$W->{'packages_used@'};
- my $packages_used_hash_save =$W->{'packages_used%'};
$W={};
tie %$W,"My::Hash::Sub";
%$W=(%WebConfig,%args); # override %WebConfig settings
- $W->{'packages_used@'}=$packages_used_array_save;
- $W->{'packages_used%'}=$packages_used_hash_save;
$W->{"__PACKAGE__"}||=caller();
# {"__PACKAGE__"} is mandatory for mod_perl-2.0;
$W->{"r"}=Apache2::RequestUtil->request();
+ $W->{"r"}->push_handlers("PerlCleanupHandler"=>\&cleanup);
+
+ $W->{"web_hostname"}||=$W->{"r"}->hostname();
+
tie *STDOUT,$W->{"r"};
select *STDOUT;
$|=1;
do { args_check(%$_) if $_; } for ($W->{"args_check"});
- $ENV{"HOSTNAME"}||=$W->{"web_hostname"};
-
return bless $W,$class;
}
my $r=Apache2::RequestUtil->request();
cluck "Calling ".'&unparsed_uri'." from a static code, going to fail" if !$r;
my $uri_string=$r->unparsed_uri() or cluck "Valid 'r' missing unparsed_uri()?";
- my $uri=URI->new_abs($uri_string,"http://".($W->{"web_hostname"}||$WebConfig{"web_hostname"})."/");
+ my $uri=URI->new_abs($uri_string,"http://".$W->{"web_hostname"}."/");
$W->{"unparsed_uri"}=$uri;
}
return $W->{"unparsed_uri"};
}
# $args{"uri_as_in"}=1 to permit passing URI objects as: $in
+# $args{"abs"}=1;
sub path_web($%)
{
my($in,%args)=@_;
Wprint "<hr />\n" if $W->{"footer"};
- my $packages_used=$W->{'packages_used@'}{$W->{"__PACKAGE__"}};
+ my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}};
if ($W->{"footer_ids"}) {
Wprint '<p class="cvs-id">';
return escapeHTML(path_web('/Redirect.pm?location='.uri_escape($uri->abs(unparsed_uri()))));
}
+our $a_href_inhibited;
sub a_href($;$%)
{
my($in,$contents,%args)=@_;
}
$contents=~s#<a\b[^>]*>##gi;
$contents=~s#</a>##gi;
+ return $contents if $a_href_inhibited;
my $path_web=path_web $in,%args;
my $r="";
return $r;
}
+sub a_href_inhibit($$;@)
+{
+my($self,$sub,@sub_args)=@_;
+
+ local $a_href_inhibited=1;
+ return &{$sub}(@sub_args);
+}
+
sub input_hidden_persistents()
{
return join("",map({
# Do not: HTTP::Headers->new($W->{"r"}->headers_in());
# to prevent empty result or even: Odd number of elements in anonymous hash
HTTP::Headers->new(%{$W->{"r"}->headers_in()}));
- $best||=$variants->[0]{"id"}; # &HTTP::Negotiate::choose failed?
+ $best||=$variants->[0][0]; # $variants->[0]{"id"}; &HTTP::Negotiate::choose failed?
return $best;
}
# FIXME: It is not clean to still append them without overwriting.
return if $W->{"heading_done"}++;
- my $lang=($W->{"language"}||"en-US");
# Workaround bug
# https://bugzilla.mozilla.org/show_bug.cgi?id=120556
# of at least
# Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8b) Gecko/20050217
my $mime;
# http://validator.w3.org/ does not send ANY "Accept" headers!
- $mime||="application/xhtml+xml" if $W->{"user_agent"}=~m{^W3C_Validator/}i;
+ $mime||="application/xhtml+xml" if !$W->{"accept"} && $W->{"user_agent"}=~m{^W3C_Validator/}i;
$mime||=$class->Negotiate_choose([
# Put the fallback variant as the first one.
# Rate both variants the same to prefer "text/html" for undecided clients.
"content-type"=>"text/html",
"qs"=>0.6,
"charset"=>$client_charset,
- "lang"=>$lang,
+ "lang"=>$W->{"language"},
),
negotiate_variant(
"id"=>"application/xhtml+xml",
"content-type"=>"application/xhtml+xml",
"qs"=>0.6,
"charset"=>$client_charset,
- "lang"=>$lang,
+ "lang"=>$W->{"language"},
),
# application/xml ?
# text/xml ?
]);
$W->{"r"}->content_type("$mime; charset=$client_charset");
Wprint '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n" if $mime=~m{^application/\w+[+]xml$};
+ return if $W->{"xml_header_only"};
Wprint '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">'."\n";
- Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="'.$lang.'">'."\n";
+ Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="'.$W->{"language"}.'">'."\n";
my $title=$W->{"title_prefix"}.join("",map({ ': '.$_; } ($W->{"title"} || ())));
+ # Do not: cluck if $title=~/[<>]/;
+ # as it is not solved just by: &a_href_inhibit
+ # as sometimes titles use also: <i>...</i>
$title=~s#<[^>]*>##g;
Wprint "<head>";
Wprint "<title>$title</title>\n";
if ($W->{"have_css"}) {
# Everything can get overriden later.
- Wprint <<"HERE";
-<link rel="stylesheet" type="text/css" href="@{[ uri_escaped(path_web "/My/Web.css") ]}" />
+ for my $css ("/My/Web.css",map((!$_ ? () : ("ARRAY" ne ref($_) ? $_ : @$_)),$W->{"css_push"})) {
+ Wprint <<"HERE";
+<link rel="stylesheet" type="text/css" href="@{[ uri_escaped(path_web $css) ]}" />
HERE
+ }
}
Wprint '<meta name="robots" content="'.($W->{"indexme"} ? "" : "no" ).'index,follow" />'."\n";
Wprint $W->{"head"};