#! /usr/bin/perl
# 
# $Id$
# Common functions for HTML/XHTML output generation
# Copyright (C) 2003 Jan Kratochvil <project-www.jankratochvil.net@jankratochvil.net>
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; exactly version 2 of June 1991 is required
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


package My::Web;
require 5.6.0;	# at least 'use warnings;' but we need some 5.6.0+ modules anyway
use vars qw($VERSION);
$VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
use strict;
use warnings;

use WebConfig;	# for %WebConfig
require CGI;	# for &escapeHTML
require Image::Size;	# for &imgsize
use File::Basename;	# &basename


my %Args;
		# $Args{"title"}
		# $Args{"force_charset"}

my $cvs_id_html;
sub init ($%)
{
my($class,%args)=@_;

	%WebConfig=(%WebConfig,%args);	# override %WebConfig settings

	undef $WebConfig{"viewcvs"} if $ENV{"SCRIPT_NAME"} && $WebConfig{"viewcvs"} eq $ENV{"SCRIPT_NAME"};
	my @cvs_id_split=split / +/,$::CVS_ID;
	if (@cvs_id_split==8) {
		$cvs_id_split[2]=""
				."<a href=\"".map({ s#/viewcvs/#&~checkout~/#; } $WebConfig{"viewcvs"})."?rev=".$cvs_id_split[2]."\">"
				.$cvs_id_split[2]."</a>";
		$cvs_id_split[1]="<a href=\"".$WebConfig{"viewcvs"}."\">".$cvs_id_split[1]."</a>";
		$cvs_id_split[5]="<a href=\"mailto:".$WebConfig{"admin_mail"}."\">".$cvs_id_split[5]."</a>";
		}
	$cvs_id_html=join " ",@cvs_id_split;
}

# $args{"ListItem"}=\%...;
sub init_project ($%)
{
my($class,%args)=@_;

	my $ListItem=$args{"ListItem"};
	my $name=$ListItem->{"name"};
	$name=~s#<a\s[^>]*>([^<]*)</a>#$1#g;
	init($class,
			"title"=>$name,
			%args);
	heading();
	print "<h1>".$ListItem->{"name"}."</h1>\n";
	print $ListItem->{"description"};
	print "<hr />\n";
	my @table=(
		{"key"=>qr(^download\b.*),"text"=>sub ($) {
						$_[0]=~s/^download//;
						$_[0]=~s/^-/ /;
						return "Download".$_[0];
						},
				"format"=>sub ($) {
						my $r;
						if ($_[0]=~m#^[a-z]+://#) {
							$r="<a href=\"".$_[0]."\">".CGI::escapeHTML($_[0])."</a>";
							}
						else {
							$r="<a href=\"".$_[0]."\">".CGI::escapeHTML(basename($_[0]))."</a>";
							my $size=(stat $_[0])[7];
							die "Cannot stat \"".$_[0]."\": $!" if !defined $size;
								 if ($size>=1024*1024) { $size=int($size/(1024*1024))." MB"; }
							elsif ($size>=1024     ) { $size=int($size/(1024     ))." KB"; }
							else                     { $size=int($size            )." B"; }
							$r.=" ($size)";
							}
						return $r;
						}},
		{"key"=>qr(^link\b.*),"text"=>sub ($) {
						$_[0]=~s/^link-//;
						return $_[0];
						},
				"format"=>sub ($) {
						return "<a href=\"".$_[0]."\">".CGI::escapeHTML($_[0])."</a>";
						}},
		{"key"=>"summary","text"=>"Summary"},
		{"key"=>"ownership","text"=>"Ownership"},
		{"key"=>"license","text"=>"License","format"=>sub ($) {
				my %known=(
						"PD"=>"Public Domain",
						"GPL"=>"<a href=\"http://www.gnu.org/licenses/gpl.html\">GNU General Public License</a>",
						"LGPL"=>"<a href=\"http://www.gnu.org/licenses/lgpl.html\">GNU Lesser General Public License</a>",
						);
				return $known{$_[0]};
				}},
		{"key"=>"maintenance","text"=>"Currently maintained?","format"=>sub ($) {
				my %known=(
						"finished"=>"Project is finished. No serious bugs known. No new features planned.",
						"dead"=>"Project became dead code. Some updates may be needed. It is no longer used.",
						);
				return $known{$_[0]};
				}},
		{"key"=>"language","text"=>"Programming language","format"=>sub ($) {
				return "<a href=\"http://java.sun.com/\">".CGI::escapeHTML($_[0])."</a>"
						if $_[0]=~/^Java\b/;
				return "<a href=\"http://www.php.net/\">".CGI::escapeHTML($_[0])."</a>"
						if $_[0]=~/^PHP\b/;
				return undef();
				}},
		);
	print '<table border="0">'."\n";

sub tableit_func
{
my($tableit,$val,$key)=@_;

	print "<tr><td>";
	if (!ref $tableit->{"text"}) {
		print $tableit->{"text"};
		}
	else {
		my $textfunc=$tableit->{"text"};
		print &$textfunc($key);
		}
	print ":</td>";
	if ($tableit->{"format"}) {
		my $format=$tableit->{"format"};
		my $valn=&$format($val);
		$val=$valn if defined $valn;
		}
	print "<td>$val</td></tr>\n";
}

	for my $tableit (@table) {
		if (!ref $tableit->{"key"}) {
			tableit_func($tableit,$ListItem->{$tableit->{"key"}},$tableit->{"key"}) if $ListItem->{$tableit->{"key"}};
			}
		else {
			for my $key (keys(%$ListItem)) {
				my $keyregex=$tableit->{"key"};
				next if $key!~/$keyregex/;
				tableit_func($tableit,$ListItem->{$key},$key);
				}
			}
		}
	print "</table>\n";
}

sub fatal (;$)
{
my($msg)=@_;

	$msg="UNKNOWN" if !$msg;

#	heading(false/*title*/,false/*indexme*/); // notitle is always safe, don't index the error message
	print("\n<p>&nbsp;<br />&nbsp;</p><hr /><h1 class=\"error\">FATAL ERROR: $msg!</h1>\n"
			."<p>You can report this problem's details to"
			." <a href=\"mailto:".$WebConfig{"admin_mail"}."\">admin of this website</a>.</p>\n");
#	footer();
}

my $footer_passed;
sub footer (;$)
{
my($delimit)=@_;

	$delimit=1 if !defined $delimit;

	exit(1) if $footer_passed++;	# deadlock prevention:

	print "<p>&nbsp;</p>\n" if $delimit;
	print "<hr />\n<p class=\"cvs-id\">$cvs_id_html</p>\n";
	print "</body></html>\n";
	exit(0);
}

my $heading_done;

my %headers;
my %headers_lc;	# maps lc($headers_key)=>$headers_key
sub header (%)
{
my(%pairs)=@_;

	while (my($key,$val)=each(%pairs)) {
		do { warn "Headers already sent"; next; } if $heading_done;
		for ($headers_lc{lc $key} || ()) {
			delete $headers{$_};
			}
		$headers_lc{lc $key}=$key;
		$headers{$key}=$val;
		}
}

sub img_size ($$)
{
my($width,$height)=@_;

	return((1 #$have_style TODO:dyn
			? "style=\"border:0;width:${width}px;height:${height}px\"" : "border=\"0\"")
			." width=\"$width\" height=\"$height\"");
}

sub img ($$;$)
{
my($file,$alt,$attrs)=@_;

	(my $file_det=$file)=~s/[.]mng$/.gif/;
	my($width,$height)=Image::Size::imgsize($file_det);
	$alt=CGI::escapeHTML($alt);
	return("<img src=\"$file\" alt=\"$alt\" title=\"$alt\" ".img_size($width,$height)
			.(!defined($attrs) ? "" : " ".$attrs)." />");
}


sub heading (;$$)
{
my($class,$showtitle,$indexme)=@_;

	$showtitle=1 if !defined $showtitle;
	$indexme=1 if !defined $indexme;

	# $ENV{"CLIENT_CHARSET"} ignored (mod_czech support dropped!)
	my $client_charset=$Args{"force_charset"} || "us-ascii";
	header("Content-type"=>"text/html; charset=$client_charset");
	header("Content-Style-Type"=>"text/css");

	if ($ENV{"SERVER_SOFTWARE"}) {
		while (my($key,$val)=each(%headers)) {
			print "$key: $val\n";
			}
		print "\n";
		}

	return if $heading_done++;

	if (1) { # || !$msie_major || $msie_major>=4) # TODO:dyn
		print '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n";
		}
	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="cs">'."\n";
	print '<head><title>'.CGI::escapeHTML($WebConfig{"title_prefix"})
			.join("",map({ ': '.CGI::escapeHTML($_); } ($WebConfig{"title"} || ())))
			.'</title>'."\n";

	if (1) { # || $have_css)	# TODO:dyn
		print <<'HERE';
<style type="text/css"><!--
.cvs-id   { font-family: monospace; }
.error    { color: red;   background-color: transparent; }
.quote    { font-family: monospace; }
.nowrap   { white-space: nowrap; }
.centered { text-align: center; }
.tab-bold { font-weight: bold; }
.tab-head { font-weight: bold; color: yellow; background-color: transparent; }
body {
		background-color: black;
		color: white;
		}
:link    { color: aqua;   background-color: transparent; }
:visited { color: teal;   background-color: transparent; }
h1,h2    { color: yellow; background-color: transparent; }
.footer img { vertical-align: middle; }
HERE

# TODO:dyn
#		if (isset($head_css))
#			print(trim($head_css)."\n");
		print "--></style>\n";
		}

	print '<meta name="robots" content="'.($indexme ? "" : "no" ).'index,follow" />'."\n";
	print $_ for ($WebConfig{"head"} || ());
	print "</head><body";
# TODO:dyn
#	if (isset($mozilla_major) && $mozilla_major==4)
#		print(" bgcolor=\"black\" text=\"white\" link=\"aqua\" vlink=\"teal\"");
	print ">\n";
#	if ($showtitle)
#		print("<h1 class=\"centered\"><a href=\"/\">"
#				."Energie & Peníze")
#				."</a></h1>\n");
}

1;