X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=blobdiff_plain;f=Web.pm;h=524cf143e94cc8cfa6a8ee8df4b85b4d6e50a5ee;hp=e41a314f3d09e47f2d524abca9ba690d5df97d32;hb=0eb3009a25310162a0e83afd5baa9520a29c2cb5;hpb=633dc05b0519d86762bd084d872d34f9183237e0

diff --git a/Web.pm b/Web.pm
index e41a314..524cf14 100644
--- a/Web.pm
+++ b/Web.pm
@@ -95,6 +95,8 @@ sub init ($%)
 {
 my($class,%args)=@_;
 
+	print STDERR "$class->init ".$ENV{"REQUEST_URI"}."\n";
+
 	my $packages_used_save=$W->{"packages_used"};
 	$W={ %WebConfig,%args };	# override %WebConfig settings
 	$W->{"packages_used"}=$packages_used_save;
@@ -156,7 +158,7 @@ my($class,%args)=@_;
 	$W->{"browser"}=HTTP::BrowserDetect->new($W->{"user_agent"});
 
 	if (!defined $W->{"have_style"}) {
-		$W->{"have_style"}=(!$W->{"browser"}->netscape() || $W->{"browser"}->major>4 ? 1 : 0);
+		$W->{"have_style"}=(!$W->{"browser"}->netscape() || ($W->{"browser"}->major() && $W->{"browser"}->major()>4) ? 1 : 0);
 		}
 
 	$W->{"have_js"}=($W->{"args"}{"have_js"} ? 1 : 0);
@@ -180,6 +182,19 @@ sub top_dir (;$)
 my($in)=@_;
 
 	if (my $uri=$ENV{"REQUEST_URI"}) {
+		if ($W->{"args"}{"Wabs"}) {
+			# FIXME: $in may not be defined here!
+			# to prevent: Use of uninitialized value in ...
+			if ($in=~m#^/#) {
+				$in=~s#^/*##;
+				}
+			else {
+				$in=$ENV{"REQUEST_URI"}."/".$in;
+				$in=~tr#/#/#s;
+				1 while $in=~s#/(?:[^/]+)/\Q..\E/#/#g
+				}
+			return "http://".&{$W->{"web_hostname_sub"}}()."/".(defined $in ? $in : "");
+			}
 		$uri.="Index" if $uri=~m#/$#;
 		if (defined $in) {
 			my($inpath,$inquery)=split /[?]/,$in,2;
@@ -298,7 +313,10 @@ sub footer (;$)
 					$cvs_id_split[2]=""
 							.a_href((map({ my $s=$_; $s=~s#/viewcvs/#$&~checkout~/#; $s; } $W->{"viewcvs"}))[0]."$file?rev=".$cvs_id_split[2],
 									$cvs_id_split[2]);
-					$cvs_id_split[1]=a_href($W->{"viewcvs"}.$file,
+					# FIXME: Use 'CVS/Repository' here.
+					my $viewcvs=$W->{"viewcvs"};
+					$viewcvs=~s#(/viewcvs)/.*$#$1/MyWeb/# if $file=~s#^My/##;
+					$cvs_id_split[1]=a_href($viewcvs.$file,
 							($package!~/^Apache::/ ? $package : $cvs_id_split[1]));
 					$cvs_id_split[5]=&{$W->{"cvs_id_author"}}($cvs_id_split[5]);
 					}
@@ -371,7 +389,11 @@ sub a_href ($;$%)
 my($url,$contents,%args)=@_;
 
 	do { $$_=1 if !defined $$_; } for (\$args{"size"});
-	$contents=CGI::escapeHTML($url) if !defined $contents;
+	if (!defined $contents) {
+		$contents=$url;
+		$contents=File::Basename::basename($contents) if $args{"basename"};
+		$contents=CGI::escapeHTML($contents);
+		}
 	$contents=~s#<a\b[^>]*>##gi;
 	$contents=~s#</a>##gi;
 
@@ -392,7 +414,7 @@ my($url,$contents,%args)=@_;
 	$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 ($args{"size"} && url_is_local($url) && ($args{"size"}>=2 || $url=~/[.](?:gz|Z|rpm|zip|deb|lha)/)) {	# Downloadable?
 		$url=top_dir_disk().$url if $url=~m#^/#;
 		if (!-r $url)
 			{ cluck "File not readable: $url"; }
@@ -613,6 +635,8 @@ my($class)=@_;
 .nowrap   { white-space: nowrap; }
 .centered { text-align: center; }
 .tab-bold { font-weight: bold; }
+.tab-head { font-weight: bold; }
+/*
 .tab-head { font-weight: bold; color: yellow; background-color: transparent; }
 body {
 		background-color: black;
@@ -621,6 +645,7 @@ body {
 :link    { color: aqua;   background-color: transparent; }
 :visited { color: teal;   background-color: transparent; }
 h1,h2    { color: yellow; background-color: transparent; }
+*/
 td       { padding: 2px; }
 caption  { caption-side: bottom; }
 .footer img { vertical-align: middle; }
@@ -635,8 +660,8 @@ HERE
 		do { print '<link rel="'.$type.'" href="'.$_.'" />'."\n" if $_; } for ($W->{"rel_$type"});
 		}
 	print "</head><body";
-	print ' bgcolor="black" text="white" link="aqua" vlink="teal"'
-			if $W->{"browser"}->netscape() && $W->{"browser"}->major<=4;
+#	print ' bgcolor="black" text="white" link="aqua" vlink="teal"'
+#			if $W->{"browser"}->netscape() && (!$W->{"browser"}->major() || $W->{"browser"}->major()<=4);
 	print ">\n";
 
 	if ($W->{"heading"}) {