descriptions updated

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index 4b8d6cb..13e397c 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -24,10 +24,44 @@ use strict;
 use warnings;
 
 use Exporter;
-our @EXPORT=qw(&require &a_href &a_href_cz &vskip &img $W &top_dir);
+sub Wrequire ($);
+sub Wuse ($@);
+our $W;
+our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img $W &top_dir);
 our @ISA=qw(Exporter);
 
-use WebConfig; # for %WebConfig
+BEGIN
+{
+       sub Wrequire ($)
+       {
+       my($file)=@_;
+
+#              print STDERR "Wrequire $file\n";
+               $file=~s#/#::#g;
+               $file=~s/[.]pm$//;
+               my $class=$file;
+               $file=~s#::#/#g;
+               $file.=".pm";
+               my $aref=($W->{"packages_used"}{$Apache::Registry::curstash}||=[]);
+               push @$aref,$class
+                               if !{ map(($_=>1),@$aref) }->{$class};  # Prevent duplicated entries.
+               CORE::require $file;
+               1;      # Otherwise 'require' would already file above.
+       }
+
+       sub Wuse ($@)
+       {
+       my($file,@list)=@_;
+
+#              print STDERR "Wuse $file\n";
+               Wrequire $file;
+               local $Exporter::ExportLevel=$Exporter::ExportLevel+1;
+               $file->import(@list);
+               1;
+       }
+}
+
+BEGIN { Wuse 'WebConfig'; }    # for %WebConfig
 require CGI;   # for &escapeHTML
 require Image::Size;   # for &imgsize
 use File::Basename;    # &basename
@@ -44,7 +78,7 @@ delete $ENV{"PERLLIB"};
 delete $ENV{"LD_LIBRARY_PATH"};
 
 
-our $W;
+#our $W;
                # $W->{"title"}
                # $W->{"head"}
                # $W->{"head_css"}
@@ -61,7 +95,9 @@ sub init ($%)
 {
 my($class,%args)=@_;
 
+       my $packages_used_save=$W->{"packages_used"};
        $W={ %WebConfig,%args };        # override %WebConfig settings
+       $W->{"packages_used"}=$packages_used_save;
 
        $W->{"__PACKAGE__"}||="Apache::ROOT".$Apache::Registry::curstash;
 
@@ -134,22 +170,6 @@ sub top_dir ()
        return $INC[0]; # fallback
 }
 
-sub require ($)
-{
-my($file)=@_;
-
-       $file=~s#/#::#g;
-       $file=~s/[.]pm$//;
-       my $class=$file;
-       $file=~s#::#/#g;
-       $file.=".pm";
-       my $aref=($W->{"packages_used"}{$Apache::Registry::curstash}||=[]);
-       push @$aref,$class
-                       if !{ map(($_=>1),@$aref) }->{$class};  # Prevent duplicated entries.
-       CORE::require $file;
-       1;      # Otherwise 'require' would already file above.
-}
-
 sub fatal (;$);
 
 sub args_check (%)
@@ -243,12 +263,22 @@ sub footer (;$)
                        } (
                                        $W->{"__PACKAGE__"},
                                        __PACKAGE__,
-                                       "WebConfig",
                                        @{$W->{"packages_used"}{$Apache::Registry::curstash}},
                                        )));
                print "</p>\n";
                }
 
+       for my $package (
+                       $W->{"__PACKAGE__"},
+                       __PACKAGE__,
+                       @{$W->{"packages_used"}{$Apache::Registry::curstash}},
+                       ) {
+               my $cvs_id=(eval('$'.$package."::CVS_ID")
+#                              || $package     # debug
+                               );
+               print '<!-- '.$package.' - $'.$cvs_id.'$ -->'."\n" if $cvs_id;
+               }
+
        if ($W->{"heading"}) {
                do { &{$_}() if $_; } for ($W->{"footing"});
                }
@@ -298,6 +328,8 @@ my($url,$contents,%args)=@_;
 
        do { $$_=1 if !defined $$_; } for (\$args{"size"});
        $contents=CGI::escapeHTML($url) if !defined $contents;
+       $contents=~s#<a\b[^>]*>##gi;
+       $contents=~s#</a>##gi;
 
        my $r='<a href="';
        my $urlent=CGI::escapeHTML($url);
@@ -311,7 +343,9 @@ my($url,$contents,%args)=@_;
                { $r.=$urlent; }
        else    # unknown client, &CGI::escapeHTML should not be needed here
                { $r.=CGI::escapeHTML(top_dir()."/Redirect.pl?location=".uri_escape($url)); }
-       $r.='">'.$contents.'</a>';
+       $r.='"';
+       do { $r.=" $_" if $_; } for ($args{"attr"});
+       $r.='>'.$contents.'</a>';
        if ($args{"size"} && url_is_local($url) && $url=~/[.](?:gz|Z|rpm|zip|deb|lha)/) {       # Downloadable?
                if (!-r $url)
                        { cluck "File not readable: $url"; }
@@ -402,6 +436,7 @@ my($file_base,$alt,$attrs)=@_;
 
        my $file=img_src $file_base;
        my($width,$height)=Image::Size::imgsize($file);
+       $alt=~s/<[^>]*>//g;
        $alt=CGI::escapeHTML($alt);
        return "<img src=\"$file\" alt=\"$alt\" title=\"$alt\" ".img_size($width,$height)
                        .(!$attrs ? "" : " ".$attrs)." />";
@@ -453,9 +488,10 @@ my($class)=@_;
                }
        print '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">'."\n";
        print '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US">'."\n";
-       print '<head><title>'.CGI::escapeHTML($W->{"title_prefix"})
-                       .join("",map({ ': '.CGI::escapeHTML($_); } ($W->{"title"} || ())))
-                       .'</title>'."\n";
+       my $title=$W->{"title_prefix"}.join("",map({ ': '.$_; } ($W->{"title"} || ())));
+       $title=~s#<[^>]*>##g;
+       print "<head>";
+       print "<title>$title</title>\n";
 
        if ($W->{"have_css"}) {
                print <<'HERE';