sub Wuse ($@);
our $W;
our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img ¢erimg &rightimg $W &top_dir &top_dir_disk &Wprint);
-our @ISA=qw(Exporter);
+our @ISA=qw(Exporter Tie::Handle);
BEGIN
{
require HTTP::Negotiate;
my $have_Geo_IP; BEGIN { $have_Geo_IP=eval { require Geo::IP; 1; }; }
use ModPerl::Util qw(exit);
+use POSIX qw(strftime);
+use Tie::Handle;
#our $W;
do { args_check(%$_) if $_; } for ($W->{"args_check"});
- return $W;
+ $ENV{"HOSTNAME"}||=&{$W->{"web_hostname_sub"}}();
+
+ return bless $W,$class;
}
sub Wprint($)
{
my($text)=@_;
- $W->{"r"}->print($text);
+ $W->{"r"}->puts($text);
+}
+
+# local *FH;
+# tie *FH,ref($W),$W;
+sub TIEHANDLE($)
+{
+my($class,$W)=@_;
+
+ my $self={};
+ $self->{"W"}=$W or confess "Missing W";
+ return bless $self,$class;
+}
+
+sub WRITE
+{
+my($self,$scalar,$length,$offset)=@_;
+
+ Wprint substr($scalar,0,$length);
}
sub top_dir_disk ()
$W->{"args"}{$name}=[ $W->{"args"}{$name} ] if !ref $W->{"args"}{$name} && ref $regex;
fatal "$name_html passed as multivar although singlevar expected"
if ref $W->{"args"}{$name} && !ref $regex;
- $regex=${$regex}[0] if ref $regex;
+ $regex=$regex->[0] if ref $regex;
for my $val (!ref $W->{"args"}{$name} ? $W->{"args"}{$name} : @{$W->{"args"}{$name}}) {
$val="" if !defined $val;
fatal "$name_html <span class=\"quote\">".CGI::escapeHTML($val)."</span>"
return @r;
}
+sub no_cache($)
+{
+my($self)=@_;
+
+ header("Expires"=>"Mon, 26 Jul 1997 05:00:00 GMT"); # date in the past
+ header("Last-Modified"=>strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime())); # always modified
+ header("Cache-Control"=>"no-cache, must-revalidate"); # HTTP/1.1
+ header("Pragma"=>"no-cache"); # HTTP/1.0
+}
+
sub heading ()
{
my($class)=@_;
my $client_charset=$W->{"force_charset"} || "us-ascii";
header("Content-Style-Type"=>"text/css");
header("Content-Script-Type"=>"text/javascript");
+ $class->no_cache() if $W->{"no_cache"};
while (my($key,$val)=each(%{$W->{"headers"}})) {
$W->{"r"}->header_out($key,$val);
Wprint "</head><body";
# Wprint ' bgcolor="black" text="white" link="aqua" vlink="teal"'
# if $W->{"browser"}->netscape() && (!$W->{"browser"}->major() || $W->{"browser"}->major()<=4);
+ do { &{$_}($W) if $_; } for $W->{"body_attr_sub"};
Wprint ">\n";
if ($W->{"heading"}) {