heading+topdir

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index 5c2b273..4b8d6cb 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -23,10 +23,8 @@ our $CVS_ID=q$Id$;
 use strict;
 use warnings;
 
-use lib qw(/home/short/lib/perl5/site_perl/5.6.0/i386-linux /home/short/lib/perl5/site_perl/5.6.0 /home/short/lib/perl5/site_perl/i386-linux /home/short/lib/perl5/site_perl /home/short/lib/perl5/5.6.0/i386-linux /home/short/lib/perl5/5.6.0 /home/short/lib/perl5/i386-linux /home/short/lib/perl5);
-
 use Exporter;
-our @EXPORT=qw(&require &a_href &a_href_cz &vskip &img $W);
+our @EXPORT=qw(&require &a_href &a_href_cz &vskip &img $W &top_dir);
 our @ISA=qw(Exporter);
 
 use WebConfig; # for %WebConfig
@@ -72,6 +70,7 @@ my($class,%args)=@_;
        do { $W->{$_}=0  if !defined $W->{$_}; } for ("detect_ent");
        do { $W->{$_}=0  if !defined $W->{$_}; } for ("detect_js");
        do { $W->{$_}=1  if !defined $W->{$_}; } for ("have_css");      # AFAIK it does not hurt anyone.
+       do { $W->{$_}=1  if !defined $W->{$_}; } for ("heading");
        do { $W->{$_}=1  if !defined $W->{$_}; } for ("footer");
        do { $W->{$_}=1  if !defined $W->{$_}; } for ("footer_delimit");
        do { $W->{$_}=1  if !defined $W->{$_}; } for ("footer_mailme");
@@ -121,7 +120,7 @@ my($class,%args)=@_;
 
        $W->{"have_js"}=($W->{"args"}{"have_js"} ? 1 : 0);
        if ($W->{"detect_js"} && !$W->{"have_js"}) {
-               $W->{"head"}.='<script type="text/javascript" src="'.$W->{"top_dir"}.'/have_js.js.pl"></script>'."\n";
+               $W->{"head"}.='<script type="text/javascript" src="'.top_dir().'/have_js.js.pl"></script>'."\n";
                }
 
        do { args_check(%$_) if $_; } for ($W->{"args_check"});
@@ -129,6 +128,12 @@ my($class,%args)=@_;
        return $W;
 }
 
+sub top_dir ()
+{
+       do { return $_ if $_; } for ($W->{"top_dir"});
+       return $INC[0]; # fallback
+}
+
 sub require ($)
 {
 my($file)=@_;
@@ -191,7 +196,7 @@ sub footer (;$)
        print "<hr />\n" if $W->{"footer"};
 
        if ($W->{"footer_mailme"}) {
-               print '<form action="'.$W->{"top_dir"}.'/SendMsg.pl" method="post" onsubmit="'
+               print '<form action="'.top_dir().'/SendMsg.pl" method="post" onsubmit="'
                                ."this.elements['msgscript'].value=this.elements['msghtml'].value;"
                                ."this.elements['msghtml'].value='';"
                                ."this.submit();"
@@ -222,7 +227,7 @@ sub footer (;$)
                                        my $ext;
                                        for (qw(.html.pl .pl .pm),"") {
                                                $ext=$_;
-                                               last if -r $W->{"top_dir"}."/$file$ext";
+                                               last if -r top_dir()."/$file$ext";
                                                cluck "Class file $file not found" if !$ext;
                                                }
                                        $file.=$ext;
@@ -243,6 +248,11 @@ sub footer (;$)
                                        )));
                print "</p>\n";
                }
+
+       if ($W->{"heading"}) {
+               do { &{$_}() if $_; } for ($W->{"footing"});
+               }
+
        print "</body></html>\n";
        exit(0);
 }
@@ -300,9 +310,9 @@ my($url,$contents,%args)=@_;
        elsif ($W->{"have_ent"})        # ent client
                { $r.=$urlent; }
        else    # unknown client, &CGI::escapeHTML should not be needed here
-               { $r.=CGI::escapeHTML("http://".$W->{"r"}->hostname()."/Redirect.pl?location=".uri_escape($url)); }
+               { $r.=CGI::escapeHTML(top_dir()."/Redirect.pl?location=".uri_escape($url)); }
        $r.='">'.$contents.'</a>';
-       if ($args{"size"} && url_is_local($url) && $url=~/[.](?:gz|rpm|zip|deb)/) {     # Downloadable?
+       if ($args{"size"} && url_is_local($url) && $url=~/[.](?:gz|Z|rpm|zip|deb|lha)/) {       # Downloadable?
                if (!-r $url)
                        { cluck "File not readable: $url"; }
                else {
@@ -326,7 +336,6 @@ sub remote_ip ()
 
 sub is_cz ()
 {
-print STDERR "IP=".remote_ip()."\n";
        return "CZ" eq Geo::IP->new()->country_code_by_addr(remote_ip());
 }
 
@@ -479,6 +488,10 @@ HERE
        print ' bgcolor="black" text="white" link="aqua" vlink="teal"'
                        if $W->{"browser"}->netscape() && $W->{"browser"}->major<=4;
        print ">\n";
+
+       if ($W->{"heading"}) {
+               do { &{$_}() if $_; } for ($W->{"heading"});
+               }
 }
 
 1;