bootstrap

diff --git a/Web.pm b/Web.pm
new file mode 100644 (file)
index 0000000..c0d8c3c
--- /dev/null
+++ b/Web.pm
@@ -0,0 +1,300 @@
+#! /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;