granicus.if.org Git - zziplib/blob - docs/mksite.pl

   1 #! /usr/bin/perl
   2 # this is the perl variant of the mksite script. It based directly on a
   3 # copy of mksite.sh which is derived from snippets that I was using to
   4 # finish doc pages for website publishing. Using only sh/sed along with
   5 # files has a great disadvantage: it is a very slow process atleast. The
   6 # perl language in contrast has highly optimized string, replace, search
   7 # functions as well as data structures to store intermediate values. As
   8 # an advantage large parts of the syntax are similar to the sh/sed variant.
   9 #
  10 #                                               http://zziplib.sf.net/mksite/
  11 #   THE MKSITE.SH (ZLIB/LIBPNG) LICENSE
  12 #       Copyright (c) 2004 Guido U. Draheim <guidod@gmx.de>
  13 #   This software is provided 'as-is', without any express or implied warranty
  14 #       In no event will the authors be held liable for any damages arising
  15 #       from the use of this software.
  16 #   Permission is granted to anyone to use this software for any purpose,
  17 #       including commercial applications, and to alter it and redistribute it
  18 #       freely, subject to the following restrictions:
  19 #    1. The origin of this software must not be misrepresented; you must not
  20 #       claim that you wrote the original software. If you use this software
  21 #       in a product, an acknowledgment in the product documentation would be
  22 #       appreciated but is not required.
  23 #    2. Altered source versions must be plainly marked as such, and must not
  24 #       be misrepresented as being the original software.
  25 #    3. This notice may not be removed or altered from any source distribution.
  26 # $Id: mksite.pl,v 1.2 2006-09-22 00:33:22 guidod Exp $
  27
  28 use strict; use warnings; no warnings "uninitialized";
  29 use File::Basename qw(basename);
  30 use POSIX qw(strftime);
  31
  32 # initialize some defaults
  33 my $SITEFILE="";
  34 $SITEFILE="site.htm"  if not $SITEFILE and -f "site.htm";
  35 $SITEFILE="site.html" if not $SITEFILE and -f "site.html";
  36 $SITEFILE="site.htm"  if not $SITEFILE;
  37 # my $MK="-mksite";     # note the "-" at the start
  38 my $SED="sed";
  39
  40 my $DATA="~~";     # extension for meta data files
  41 my $HEAD="~head~"; # extension for head sed script
  42 my $BODY="~body~"; # extension for body sed script
  43 my $FOOT="~foot~"; # append to body text (non sed)
  44
  45 my $SED_LONGSCRIPT="$SED -f";
  46
  47 my $az="a-z";                                     # for perl
  48 my $AZ="A-Z";                                     # we may assume there are
  49 my $NN="0-9";                                     # char-ranges available
  50 my $AA="_$NN$AZ$az";                              # that makes the resulting
  51 my $AX="$AA.+-";                                  # script more readable
  52
  53 my $n = "\n";
  54 my $Q = "q class";
  55 my $QX = "/q";
  56
  57 # LANG="C" ; LANGUAGE="C" ; LC_COLLATE="C"     # these are needed for proper
  58 # export LANG LANGUAGE LC_COLLATE              # lowercasing as some collate
  59                                                # treat A-Z to include a-z
  60
  61 my @HTMLTAGS = qw/a p h1 h2 h3 h4 h5 h6 dl dd dt ul ol li pre code
  62     table tr td th b u i s q em strong strike cite big small sup sub tt
  63     thead tbody center hr br nobr wbr span div img adress blockquote/;
  64 my @HTMLTAGS2 = qw/html head body title meta http-equiv style link/;
  65
  66 # ==========================================================================
  67 my $hint="";
  68
  69 sub echo
  70 {
  71     print join(" ",@_),$n;
  72 }
  73 sub error
  74 {
  75     print STDERR "ERROR: ", join(" ",@_),$n;
  76 }
  77 sub warns
  78 {
  79     print STDERR "WARN: ", join(" ",@_), $n;
  80 }
  81 sub hint
  82 {
  83     print STDERR "NOTE: ", join(" ", @_), $n if $hint;
  84 }
  85 sub init
  86 {
  87     $hint="1" if -d "DEBUG";
  88 }
  89
  90 &init ("NOW!!!");
  91
  92 sub ls_s {
  93     my $x=`ls -s @_`;
  94     chomp($x);
  95     return $x;
  96 }
  97
  98 # ==========================================================================
  99 # reading options from the command line                            GETOPT
 100 my %o = (); # to store option variables
 101 $o{variables}="files";
 102 $o{fileseparator}="?";
 103 $o{files}="";
 104 $o{main_file}="";
 105 $o{formatter}="$0";
 106 my $opt="";
 107 for my $arg (@ARGV) {     # this variant should allow to embed spaces in $arg
 108     if ($opt) {
 109         $o{$opt}=$arg;
 110         $opt="";
 111     } else {
 112         $_=$arg;
 113         if (/^-.*=.*$/) {
 114             $opt=$arg; $opt =~ s/-*([$AA][$AA-]*).*/$1/; $opt =~ y/-/_/;
 115             if (not $opt) {
 116                 error "invalid option $arg";
 117             } else {
 118                 $arg =~ s/^[^=]*=//;
 119                 $o{$opt} = $arg;
 120                 $o{variables} .= " ".$opt;
 121             }
 122             $opt="";;
 123         } elsif (/^-.*.-.*$/) {
 124             $opt=$arg; $opt =~ s/-*([$AA][$AA-]*).*/$1/; $opt =~ y/-/_/;
 125             if (not $opt) {
 126                 error "invalid option $arg";
 127                 $opt="";
 128             } else {
 129                     # keep the option for next round
 130             } ;;
 131         } elsif (/^-.*/) {
 132             $opt=$arg; $opt =~ s/^-*([$AA][$AA-]*).*/$1/; $opt =~ y/-/_/;
 133             if (not $opt) {
 134                 error "invalid option $arg";
 135             } else {
 136                 $arg =~ s/^[^=]*=//;
 137                 $o{$opt} = ' ';
 138             }
 139             $opt="" ;;
 140         } else {
 141             hint "<$arg>";
 142             if (not $o{main_file}) { $o{main_file} = $arg; } else {
 143             $o{files} .= $o{fileseparator} if $o{files};
 144             $o{files} .= $arg; };
 145             $opt="" ;;
 146         };
 147     }
 148 } ; if ($opt) {
 149         $o{$opt}=" ";
 150         $opt="";
 151     }
 152
 153 ### env | grep ^opt
 154
 155 $SITEFILE=$o{main_file} if $o{main_file} and -f $o{main_file};
 156 $SITEFILE=$o{site_file} if $o{site_file} and -f $o{site_file};
 157 $hint="1" if $o{debug};
 158
 159 if ($o{help}) {
 160     $_=$SITEFILE;
 161     echo "$0 [sitefile]";
 162     echo "  default sitefile = $_  ($o{main_file}) ($o{files})";
 163     echo "options:";
 164     echo " --filelist : show list of target files as ectracted from $_";
 165     echo " --src-dir xx : if source files are not where mksite is executed";
 166     echo " --tmp-dir xx : use temp instead of local directory";
 167     echo " --tmp : use automatic temp directory in \$TEMP/mksite.*";
 168     exit;
 169     echo " internal:";
 170     echo "--fileseparator=x : for building the internal filelist (def. '?')";
 171     echo "--files xx : for list of additional files to be processed";
 172     echo "--main-file xx : for the main sitefile to take file list from";
 173 }
 174
 175 if (not $SITEFILE) {
 176     error "no SITEFILE found (default would be 'site.htm')$n";
 177     exit 1;
 178 } else {
 179     hint "sitefile: ", ls_s($SITEFILE);
 180 }
 181
 182 # we use internal hashes to store mappings - kind of relational tables
 183 my @MK_TAGS= (); # "./$MK.tags.tmp"
 184 my @MK_VARS= (); # "./$MK.vars.tmp"
 185 my @MK_SPAN= (); # "./$MK.span.tmp"
 186 my @MK_META= (); # "./$MK.meta.tmp"
 187 my @MK_METT= (); # "./$MK.mett.tmp"
 188 my @MK_TEST= (); # "./$MK.test.tmp"
 189 my @MK_FAST= (); # "./$MK.fast.tmp"
 190 my @MK_GETS= (); # "./$MK.gets.tmp"
 191 my @MK_PUTS= (); # "./$MK.puts.tmp"
 192 my @MK_OLDS= (); # "./$MK.olds.tmp"
 193 my @MK_SITE= (); # "./$MK.site.tmp"
 194 my @MK_SECT1= (); # "./$MK.sect1.tmp"
 195 my @MK_SECT2= (); # "./$MK.sect2.tmp"
 196 my @MK_SECT3= (); # "./$MK.sect3.tmp"
 197 my @MK_DATA= (); # "./$MK~~"
 198 my %DATA= (); # used for $F.$PARTs
 199
 200 # ========================================================================
 201 # ========================================================================
 202 # ========================================================================
 203 #                                                             MAGIC VARS
 204 #                                                            IN $SITEFILE
 205 my $printerfriendly="";
 206 my $sectionlayout="list";
 207 my $sitemaplayout="list";
 208 my $attribvars=" ";         # <x ref="${varname:=default}">
 209 my $updatevars=" ";         # <!--$varname:=-->default
 210 my $expandvars=" ";         # <!--$varname-->
 211 my $commentvars=" ";        # $updatevars && $expandsvars
 212 my $sectiontab=" ";         # highlight ^<td class=...>...href="$section"
 213 my $currenttab=" ";         # highlight ^<br>..<a href="$topic">
 214 my $headsection="no";
 215 my $tailsection="no";
 216 my $sectioninfo="no";       # using <h2> title <h2> = info text
 217 my $emailfooter="no";
 218
 219 for (source($SITEFILE)) {
 220     if (/<!--multi-->/) {
 221         warns("do not use <!--multi-->,"
 222              ." change to <!--mksite:multi-->  $SITEFILE"
 223              ."warning: or"
 224              ." <!--mksite:multisectionlayout-->"
 225              ." <!--mksite:multisitemaplayout-->");
 226         $sectionlayout="multi";
 227         $sitemaplayout="multi";
 228     }
 229     if (/<!--mksite:multi-->/) {
 230         $sectionlayout="multi";
 231         $sitemaplayout="multi";
 232     }
 233     if (/<!--mksite:multilayout-->/) {
 234         $sectionlayout="multi";
 235         $sitemaplayout="multi";
 236     }
 237 }
 238
 239 sub mksite_magic_option
 240 {
 241     # $1 is word/option to check for
 242     my ($U,$INP,$Z) = @_;
 243     $INP=$SITEFILE if not $INP;
 244     for (source($INP)) {
 245         s/(<!--mksite:)($U)-->/$1$2: -->/g;
 246         s/(<!--mksite:)(\w\w*)($U)-->/$1$3:$2-->/g;
 247         /<!--mksite:$U:/ or next;
 248         s/.*<!--mksite:$U:([^<>]*)-->.*/$1/;
 249         s/.*<!--mksite:$U:([^-]*)-->.*/$1/;
 250         /<!--mksite:$U:/ and next;
 251         chomp;
 252         return $_;
 253     }
 254     return "";
 255 }
 256
 257 {
 258     my $x;
 259     $x=mksite_magic_option("sectionlayout"); if
 260         ($x =~ /^(list|multi)$/) { $sectionlayout="$x" ; }
 261     $x=mksite_magic_option("sitemaplayout"); if
 262         ($x =~ /^(list|multi)$/) { $sitemaplayout="$x" ; }
 263     $x=mksite_magic_option("attribvars"); if
 264         ($x =~ /^( |no|warn)$/) { $attribvars="$x" ; }
 265     $x=mksite_magic_option("updatevars"); if
 266         ($x =~ /^( |no|warn)$/) { $updatevars="$x" ; }
 267     $x=mksite_magic_option("expandvars"); if
 268         ($x =~ /^( |no|warn)$/) { $expandvars="$x" ; }
 269     $x=mksite_magic_option("commentvars"); if
 270         ($x =~ /^( |no|warn)$/) { $commentvars="$x" ; }
 271     $x=mksite_magic_option("printerfriendly"); if
 272         ($x =~ /^( |[.].*|[-]-.*)$/) { $printerfriendly="$x" ; }
 273     $x=mksite_magic_option("sectiontab"); if
 274         ($x =~ /^( |no|warn)$/) { $sectiontab="$x" ; }
 275     $x=mksite_magic_option("currenttab"); if
 276         ($x =~ /^( |no|warn)$/) { $currenttab="$x" ; }
 277     $x=mksite_magic_option("sectioninfo"); if
 278         ($x =~ /^( |no|[=:-])$/) { $sectioninfo="$x" ; }
 279     $x=mksite_magic_option("commentvars"); if
 280         ($x =~ /^( |no|warn)$/) { $commentvars="$x" ; }
 281     $x=mksite_magic_option("emailfooter"); if
 282         ($x) { $emailfooter="$x"; }
 283 }
 284
 285 $printerfriendly=$o{print} if $o{print};
 286 $updatevars="no" if $commentvars eq "no"; # duplicated into
 287 $expandvars="no" if $commentvars eq "no"; # info2vars_sed
 288
 289 hint "'$sectionlayout\'sectionlayout '$sitemaplayout\'sitemaplayout";
 290 hint "'$attribvars\'attribvars '$updatevars\'updatevars";
 291 hint "'$expandvars\'expandvars '$commentvars\'commentvars";
 292 hint "'$currenttab\'currenttab '$sectiontab\'sectiontab";
 293 hint "'$headsection\'headsection '$tailsection\'tailsection";
 294
 295 # ==========================================================================
 296 # init a few global variables
 297 #                                                                  0. INIT
 298
 299 # $MK.tags.tmp - originally, we would use a lambda execution on each
 300 # uppercased html tag to replace <P> with <p class="P">. Here we just
 301 # walk over all the known html tags and make an sed script that does
 302 # the very same conversion. There would be a chance to convert a single
 303 # tag via "h;y;x" or something we do want to convert all the tags on
 304 # a single line of course.
 305 @MK_TAGS=();
 306 { my ($M,$P); for $M (@HTMLTAGS) {
 307     $P=uc($M);
 308     push @MK_TAGS, "s|<$P>|<$M class=\\\"$P\\\">|g;";
 309     push @MK_TAGS, "s|<$P |<$M class=\\\"$P\\\" |g;";
 310     push @MK_TAGS, "s|</$P>|</$M>|g;";
 311 }}
 312 push @MK_TAGS, "s|<>|\\&nbsp\\;|g;";
 313 push @MK_TAGS, "s|<->|<WBR />\\;|g;";
 314 push @MK_TAGS, "s|<c>|<code>|g;";
 315 push @MK_TAGS, "s|</c>|</code>|g;";
 316 push @MK_TAGS, "s|<section>||g;";
 317 push @MK_TAGS, "s|</section>||g;";
 318 push @MK_TAGS, "s|<(a [^<>]*) />|<\$1></a>|g";
 319 my $_ulink_="<a href=\"\$1\" remap=\"url\">\$1</a>";
 320 push @MK_TAGS, "s|<a>\\s*(\\w+://[^<>]*)</a>|$_ulink_|g;";
 321 # also make sure that some non-html entries are cleaned away that
 322 # we are generally using to inject meta information. We want to see
 323 # that meta ino in the *.htm browser view during editing but they
 324 # shall not get present in the final html page for publishing.
 325 my @DC_VARS =
 326     ("contributor", "date", "source", "language", "coverage", "identifier",
 327      "rights", "relation", "creator", "subject", "description",
 328      "publisher", "DCMIType");
 329 my @_EQUIVS =
 330     ("refresh", "expires", "content-type", "cache-control",
 331      "redirect", "charset", # mapped to refresh / content-type
 332      "content-language", "content-script-type", "content-style-type");
 333 { my $P; for $P (@DC_VARS) { # dublin core embedded
 334     push @MK_TAGS, "s|<$P>[^<>]*</$P>||g;";
 335 }}
 336 { my $P; for $P (@_EQUIVS) {
 337     push @MK_TAGS, "s|<$P>[^<>]*</$P>||g;";
 338 }}
 339 push @MK_TAGS, "s|<a sect=\\\"[$AZ$NN]\\\"|<a|g;" if not $o{keepsect};
 340 push @MK_TAGS, "s|<!--[$AX]*[?]-->||g;";
 341 push @MK_TAGS, "s|<!--\\\$[$AX]*[?]:-->||g;";
 342 push @MK_TAGS, "s|<!--\\\$[$AX]*:[?=]-->||g;";
 343 push @MK_TAGS, "s|(<[^<>]*)\\\${[$AX]*:[?=]([^<{}>]*)}([^<>]*>)|\$1\$2\$3|g;";
 344
 345 my $TRIMM=" -e 's:^ *::' -e 's: *\$::'";  # trimm away leading/trailing spaces
 346 sub trimm
 347 {
 348     my ($T,$Z) = @_;
 349     $T =~ s:\A\s*::s; $T =~ s:\s*\Z::s;
 350     return $T;
 351 }
 352 sub trimmm
 353 {
 354     my ($T,$Z) = @_;
 355     $T =~ s:\A\s*::s; $T =~ s:\s*\Z::s; $T =~ s:\s+: :g;
 356     return $T;
 357 }
 358 sub timezone
 359 {
 360     # +%z is an extension while +%Z is supposed to be posix
 361     my $tz;
 362     eval { $tz = strftime("%z", localtime()) };
 363     return $tz  if $tz =~ /[+]/;
 364     return $tz  if $tz =~ /[-]/;
 365     return strftime("%Z", localtime());
 366 }
 367
 368 sub timetoday
 369 {
 370     return strftime("%Y-%m-%d", localtime());
 371 }
 372 sub timetodays
 373 {
 374     return strftime("%Y-%m%d", localtime());
 375 }
 376
 377 sub esc
 378 {
 379     my ($TXT,$XXX) = @_;
 380     $TXT =~ s|&|\\\\&|g;
 381     return $TXT;
 382 }
 383
 384 my %SOURCE;
 385 sub source # $file : @lines
 386 {
 387     my ($FILE,$Z) = @_;
 388     if (exists $SOURCE{$FILE}) { return @{$SOURCE{$FILE}}; }
 389     my @TEXT = ();
 390     open FILE, "<$FILE" or die "could not open $FILE: $!";
 391     for my $line (<FILE>) {
 392         push @TEXT, $line;
 393     } close FILE;
 394     @{$SOURCE{$FILE}} = @TEXT;
 395     return @{$SOURCE{$FILE}};
 396 }
 397 sub savesource # $file \@lines
 398 {
 399     my ($FILE,$LINES,$Z) = @_;
 400     @{$SOURCE{$FILE}} = @{$LINES};
 401 }
 402
 403 my $F; # current file during loop <<<<<<<<<
 404 my $i = 100;
 405 sub savelist {
 406     if (-d "DEBUG") {
 407         my ($script,$ext,$Z) = @_;
 408         if (not $ext) { $ext = "_".$i; $i++; }
 409         my $X = "$F.$ext.tmp.PL"; $X =~ s|/|:|g;
 410         open X, ">DEBUG/$X" or die "could not open $X: $!";
 411         print X "#! /usr/bin/env perl",$n;
 412         print X "# ",$#_," $ext files ",localtime(),$n;
 413         my $TEXT = join("$n", @{$script});
 414         $TEXT =~ s|source\([^()]*\)|<>|;
 415         print X $TEXT,$n; close X;
 416     }
 417 }
 418
 419 sub eval_MK_LIST # $str @list
 420 {
 421     my $FILETYPE = $_[0]; shift @_;
 422     my $result = $_[0]; shift @_;
 423     my $extra = "";
 424     my $script = "\$_ = \$result; my \$Z;";
 425     $script .= join(";$n ", @_);
 426     $script .= "$n;\$result = \$_;$n";
 427     savelist([$script],$FILETYPE);
 428     eval $script;
 429     return $result.$extra;
 430 }
 431
 432 sub eval_MK_FILE  {
 433     my $FILETYPE = $_[0]; shift @_;
 434     my $FILENAME = $_[0]; shift @_;
 435     my $result = "";
 436     my $script = "my \$FILE; my \$extra = ''; my \$Z; $n";
 437     $script.= "for (source('$FILENAME')) { $n";
 438     $script.= join(";$n  ", @_);
 439     $script.= "$n; \$result .= \$_; ";
 440     $script.= "$n if(\$extra){\$result.=\$extra;\$extra='';\$result.=\"\\n\"}";
 441     $script.= "$n} if(\$extra){\$result.=\$extra;}$n";
 442     savelist([$script],$FILETYPE);
 443     eval $script;
 444     return $result;
 445 }
 446 my $sed_add = "\$extra .= "; # "/r ";
 447
 448 sub foo { print "               '$F'$n"; }
 449
 450 # ======================================================================
 451 #                                                                FUNCS
 452
 453 my $SOURCEFILE; # current file <<<<<<<<
 454 my @FILELIST; # <<<<<<<
 455
 456 sub sed_slash_key  # helper to escape chars special in /anchor/ regex
 457 {                     # currently escaping "/" "[" "]" "."
 458     my $R = $_[0]; $R =~ s|[\"./[-]|\\$&|g; $R =~ s|\]|\\\\$&|g;
 459     return $R;
 460 }
 461 sub sed_piped_key  # helper to escape chars special in s|anchor|| regex
 462 {                     # currently escaping "|" "[" "]" "."
 463     my $R = $_[0]; $R =~ s/[\".|[-]/\\$&/g; $R =~ s/\]/\\\\$&/g;
 464     return $R;
 465 }
 466
 467 sub back_path      # helper to get the series of "../" for a given path
 468 {
 469     my ($R,$Z) = @_; if ($R !~ /\//) { return ""; }
 470     $R =~ s|/[^/]*$|/|; $R =~ s|[^/]*/|../|g;
 471     return $R;
 472 }
 473
 474 sub dir_name
 475 {
 476     my $R = $_[0]; $R =~ s:/[^/][^/]*\$::;
 477     return $R;
 478 }
 479
 480 sub info2vars_sed      # generate <!--$vars--> substition sed addon script
 481 {
 482     my ($INP,$Z) = @_;
 483     $INP = \@{$DATA{$F}} if not $INP;
 484     my @OUT = ();
 485     my $V8=" *([^ ][^ ]*) +(.*)<$QX>";
 486     my $V9=" *DC[.]([^ ][^ ]*) +(.*)<$QX>";
 487     my $N8=" *([^ ][^ ]*) ([$NN].*)<$QX>";
 488     my $N9=" *DC[.]([^ ][^ ]*) ([$NN].*)<$QX>";
 489     my $V0="([<]*)\\\$";
 490     my $V1="([^<>]*)\\\$";
 491     my $V2="([^{<>}]*)";
 492     my $V3="([^<>]*)";
 493     my $SS="<"."<>".">"; # spacer so value="2004" dont make for s|\(...\)|\12004|
 494     $Z="\$Z=";
 495     $updatevars = "no" if $commentvars  eq "no";   # duplicated from
 496     $expandvars = "no" if $commentvars  eq "no";   # option handling
 497     my @_INP = (); for (@{$INP}) {
 498         my $x=$_; $x =~ s/(>[^<>]*)'([^<>]*<)/$1\\'$2/; push @_INP, $x; # OOOOPS
 499     }
 500     if ($expandvars ne "no") {
 501         for (@_INP) {
 502     if    (/^=....=formatter /) { next; }
 503     elsif (/^<$Q='name'>$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|- \$Z|;"}
 504     elsif (/^<$Q='Name'>$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|(\$Z)|;"}
 505     elsif (/^<$Q='name'>$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|- \$Z|;"}
 506     elsif (/^<$Q='Name'>$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|(\$Z)|;"}
 507         }
 508     }
 509     if ($expandvars ne "no") {
 510         for (@_INP) {
 511     if    (/^=....=formatter /) { next; }
 512     elsif (/^<$Q='text'>$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 513     elsif (/^<$Q='Text'>$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 514     elsif (/^<$Q='name'>$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 515     elsif (/^<$Q='Name'>$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 516     elsif (/^<$Q='text'>$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 517     elsif (/^<$Q='Text'>$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 518     elsif (/^<$Q='name'>$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 519     elsif (/^<$Q='Name'>$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 520         }
 521     }
 522     if ($updatevars ne "no") {
 523         for (@_INP) {  my $H = "[^<>]*";
 524     if    (/^=....=formatter /) { next; }
 525     elsif (/^<$Q='name'>$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$H|- \$Z|;"}
 526     elsif (/^<$Q='Name'>$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$H|(\$Z)|;"}
 527     elsif (/^<$Q='name'>$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$H|- \$Z|;"}
 528     elsif (/^<$Q='Name'>$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$H|(\$Z)|;"}
 529         }
 530     }
 531     if ($updatevars ne "no") {
 532         for (@_INP) {  my $H = "[^<>]*";
 533     if    (/^=....=formatter /) { next; }
 534     elsif (/^<$Q='text'>$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$H|\$1$SS\$Z|;"}
 535     elsif (/^<$Q='Text'>$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$H|\$1$SS\$Z|;"}
 536     elsif (/^<$Q='name'>$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$H|\$1$SS\$Z|;"}
 537     elsif (/^<$Q='Name'>$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$H|\$1$SS\$Z|;"}
 538     elsif (/^<$Q='text'>$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$H|\$1$SS\$Z|;"}
 539     elsif (/^<$Q='Text'>$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$H|\$1$SS\$Z|;"}
 540     elsif (/^<$Q='name'>$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$H|\$1$SS\$Z|;"}
 541     elsif (/^<$Q='Name'>$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$H|\$1$SS\$Z|;"}
 542         }
 543     }
 544     if ($attribvars ne "no") {
 545         for (@_INP) {  my $H = "[^<>]*";
 546     if    (/^=....=formatter /) { next; }
 547     elsif (/^<$Q='text'>$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 548     elsif (/^<$Q='Text'>$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 549     elsif (/^<$Q='name'>$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 550     elsif (/^<$Q='Name'>$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 551     elsif (/^<$Q='text'>$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 552     elsif (/^<$Q='Text'>$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 553     elsif (/^<$Q='name'>$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 554     elsif (/^<$Q='Name'>$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 555         }
 556         for (split / /, $o{variables}) {
 557             {push @OUT,"\$Z='$o{$_}';s|<$V1\{$_:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 558         }
 559     }
 560     # if value="2004" then generated sed might be "\\12004" which is bad
 561     # instead we generate an edited value of "\\1$SS$value" and cut out
 562     # the spacer now after expanding the variable values:
 563     push @OUT, "s|$SS||g;";
 564     return @OUT;
 565
 566 }
 567
 568 sub info2meta_sed     # generate <meta name..> text portion
 569 {
 570     my ($INP,$XXX) = @_;
 571     $INP = \@{$DATA{$F}} if not $INP;
 572     my @OUT = ();
 573     # http://www.metatab.de/meta_tags/DC_type.htm
 574     my $V6=" *HTTP[.]([^ ]+) (.*)<$QX>";
 575     my $V7=" *DC[.]([^ ]+) (.*)<$QX>";
 576     my $V8=" *([^ ]+) (.*)<$QX>" ;
 577     sub __TYPE_SCHEME { "name=\"DC.type\" content=\"$2\" scheme=\"$1\"" };
 578     sub __DCMI { "name=\"$1\" content=\"$2\" scheme=\"DCMIType\"" };
 579     sub __NAME { "name=\"$1\" content=\"$2\"" };
 580     sub __NAME_TZ { "name=\"$1\" content=\"$2 ".&timezone()."\"" };
 581     sub __HTTP { "http-equiv=\"$1\" content=\"$2\"" };
 582     for (@$INP) {
 583         if (/=....=today /) { next; }
 584         if (/<$Q='meta'>HTTP[.]/ && /<$Q='meta'>$V6/) {
 585             push @OUT, " <meta ${\(__HTTP)} />" if $2; next; }
 586         if (/<$Q='meta'>DC[.]DCMIType / && /<$Q='meta'>$V7/) {
 587             push @OUT, " <meta ${\(__TYPE_SCHEME)} />" if $2; next; }
 588         if (/<$Q='meta'>DC[.]type Collection$/ && /<$Q='meta'>$V8/) {
 589             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 590         if (/<$Q='meta'>DC[.]type Dataset$/ && /<$Q='meta'>$V8/) {
 591             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 592         if (/<$Q='meta'>DC[.]type Event$/ && /<$Q='meta'>$V8/) {
 593             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 594         if (/<$Q='meta'>DC[.]type Image$/ && /<$Q='meta'>$V8/) {
 595             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 596         if (/<$Q='meta'>DC[.]type Service$/ && /<$Q='meta'>$V8/) {
 597             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 598         if (/<$Q='meta'>DC[.]type Software$/ && /<$Q='meta'>$V8/) {
 599             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 600         if (/<$Q='meta'>DC[.]type Sound$/ && /<$Q='meta'>$V8/) {
 601             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 602         if (/<$Q='meta'>DC[.]type Text$/ && /<$Q='meta'>$V8/) {
 603             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 604         if (/<$Q='meta'>DC[.]date[.].*[+]/ && /<$Q='meta'>$V8/) {
 605             push @OUT, " <meta ${\(__NAME)} />" if $2; next; }
 606         if (/<$Q='meta'>DC[.]date[.].*[:]/ && /<$Q='meta'>$V8/) {
 607             push @OUT, " <meta ${\(__NAME_TZ)} />" if $2; next; }
 608         if (/<$Q='meta'>/ && /<$Q='meta'>$V8/) {
 609             push @OUT, " <meta ${\(__NAME)} />" if $2; next; }
 610     }
 611     return @OUT;
 612 }
 613
 614 sub info_get_entry # get the first <!--vars--> value known so far
 615 {
 616     my ($TXT,$INP,$XXX) = @_;
 617     $TXT = "sect" if not $TXT;
 618     $INP = \@{$DATA{$F}} if not $INP;
 619     for (grep {/<$Q='text'>$TXT /} @$INP) {
 620         my $info = $_;
 621         $info =~ s|<$Q='text'>$TXT ||; $info =~ s|<$QX>||;
 622         chomp($info); chomp($info); return $info;
 623     }
 624 }
 625
 626 sub info1grep # test for a <!--vars--> substition to be already present
 627 {
 628     my ($TXT,$INP,$XXX) = @_;
 629     $TXT = "sect" if not $TXT;
 630     $INP = \@{$DATA{$F}} if not $INP;
 631     return scalar(grep {/^<$Q='text'>$TXT /} @$INP); # returning the count
 632 }
 633
 634 sub dx_init
 635 {
 636     @{$DATA{$F}} = ();
 637     &dx_meta ("formatter", basename($o{formatter}));
 638     for (split / /, $o{variables}) {        # commandline --def=value
 639         if (/_/) { my $u=$_; $u =~ y/_/-/;  # makes for <!--$def--> override
 640                    &dx_meta ($u, $o{$_});
 641         } else {   &dx_text ($_, $o{$_}); }
 642     }
 643 }
 644
 645 sub dx_line
 646 {
 647     my ($U,$V,$W,$Z) = @_; chomp($U); chomp($V);
 648     push @{$DATA{$F}}, "<$Q=$U>".$V." ".trimmm($W)."<$QX>";
 649 }
 650
 651 sub DX_line
 652 {
 653     my ($U,$V,$W,$Z) = @_; $W =~ s/<[^<>]*>//g;
 654     &dx_line ($U,$V,$W);
 655 }
 656
 657 sub dx_text
 658 {
 659     my ($U,$V,$Z) = @_;
 660     &dx_line ("'text'",$U,$V);
 661 }
 662
 663 sub DX_text   # add a <!--vars--> substition includings format variants
 664 {
 665     my ($N, $T,$XXX) = @_;
 666     $N = trimm($N); $T = trimm($T);
 667     if ($N) {
 668         if ($T) {
 669             my $text=lc("$T"); $text =~ s/<[^<>]*>//g;
 670             &dx_line ("'text'",$N,$T);
 671             &dx_line ("'name'",$N,$text);
 672             my $varname=$N; $varname =~ s/.*[.]//;  # cut out front part
 673             if ($N ne $varname and $varname) {
 674                 $text=lc("$varname $T"); $text =~ s/<[^<>]*>//g;
 675                 &dx_line ("'Text'",$varname,$T);
 676                 &dx_line ("'Name'",$varname,$text);
 677             }
 678         }
 679     }
 680 }
 681
 682 sub dx_meta
 683 {
 684     my ($U,$V,$Z) = @_;
 685     &DX_line ("'meta'",$U,$V);
 686 }
 687
 688 sub DX_meta  # add simple meta entry and its <!--vars--> subsitution
 689 {
 690     my ($U,$V,$Z) = @_;
 691     &DX_line ("'meta'",$U,$V);
 692     &DX_text ("$U", $V);
 693 }
 694
 695 sub DC_meta   # add new DC.meta entry plus two <!--vars--> substitutions
 696 {
 697     my ($U,$V,$Z) = @_;
 698     &DX_line ("'meta'","DC.$U",$V);
 699     &DX_text ("DC.$U", $V);
 700     &DX_text ("$U", $V);
 701 }
 702
 703 sub HTTP_meta   # add new HTTP.meta entry plus two <!--vars--> substitutions
 704 {
 705     my ($U,$V,$Z) = @_;
 706     &DX_line ("'meta'","HTTP.$U",$V);
 707     &DX_text ("HTTP.$U", $V);
 708     &DX_text ("$U", $V);
 709 }
 710
 711 sub DC_VARS_Of # check DC vars as listed in $DC_VARS global/generate DC_meta
 712 {                 # the results will be added to .meta.tmp and .vars.tmp later
 713     my ($FILENAME,$Z)= @_;
 714     $FILENAME=$SOURCEFILE if not $FILENAME;
 715     for my $M (@DC_VARS, "title") {
 716         # scan for a <markup> of this name                  FIXME
 717         my ($part,$text);
 718         for (source($FILENAME)) {
 719             /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 720             $part = trimm($_); last;
 721         }
 722         $text=$part;  $text =~ s|^\w*:||; $text = trimm($text);
 723         next if not $text;
 724         # <mark:part> will be <meta name="mark.part">
 725         if ($text ne $part) {
 726             my $N=$part; $N =~ s/:.*//;
 727             &DC_meta ("$M.$N", $text);
 728         } elsif ($M eq "date") {
 729             &DC_meta ("$M.issued", $text); # "<date>" -> "<date>issued:"
 730         } else {
 731             &DC_meta ("$M", $text);
 732         }
 733     }
 734 }
 735
 736 sub HTTP_VARS_Of  # check HTTP-EQUIVs as listed in $_EQUIV global then
 737 {                 # generate meta tags that are http-equiv= instead of name=
 738     my ($FILENAME,$Z)= @_;
 739     $FILENAME=$SOURCEFILE if not $FILENAME;
 740     for my $M (@_EQUIVS) {
 741         # scan for a <markup> of this name                  FIXME
 742         my ($part,$text);
 743         for (source($FILENAME)) {
 744             /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 745             $part = trimm($_); last;
 746         }
 747         $text=$part;  $text =~ s|^\w*:||; $text = trimm($text);
 748         next if not $text;
 749         if ($M eq "redirect") {
 750             &HTTP_meta ("refresh", "5; url=$text"); &DX_text ("$M", $text);
 751         } elsif ($M eq "charset") {
 752             &HTTP_meta ("content-type", "text/html; charset=$text");
 753         } else {
 754             &HTTP_meta ("$M", $text);
 755         }
 756     }
 757 }
 758
 759 sub DC_isFormatOf   # make sure there is this DC.relation.isFormatOf tag
 760 {                      # choose argument for a fallback (usually $SOURCEFILE)
 761     my ($NAME,$Z) = @_;
 762     $NAME=$SOURCEFILE if not $NAME;
 763     if (not &info1grep ("DC.relation.isFormatOf")) {
 764         &DC_meta ("relation.isFormatOf", "$NAME");
 765     }
 766 }
 767
 768 sub DC_publisher    # make sure there is this DC.publisher meta tag
 769 {                      # choose argument for a fallback (often $USER)
 770     my ($NAME,$Z) = @_;
 771     $NAME=$ENV{"USER"} if not $NAME;
 772     if (not &info1grep ("DC.publisher")) {
 773         &DC_meta ("publisher", "$NAME");
 774     }
 775 }
 776
 777 sub DC_modified     # make sure there is a DC.date.modified meta tag
 778 {                      # maybe choose from filesystem dates if possible
 779     my ($ZZ,$Z) = @_; # target file
 780     if (not &info1grep ("DC.date.modified")) {
 781         my @stats = stat($ZZ);
 782         my $text =  strftime("%Y-%m-%d", localtime($stats[9]));
 783         &DC_meta ("date.modified", $text);
 784     }
 785 }
 786
 787 sub DC_date         # make sure there is this DC.date meta tag
 788 {                      # choose from one of the available DC.date.* specials
 789     my ($ZZ,$Z) = @_; # source file
 790     if (&info1grep ("DC.date")) {
 791         &DX_text ("issue", "dated ".&info_get_entry("DC.date"));
 792         &DX_text ("updated", &info_get_entry("DC.date"));
 793     } else {
 794         my $text=""; my $kind;
 795         for $kind (qw/available issued modified created/) {
 796             $text=&info_get_entry("DC.date.$kind");
 797             # test ".$text" != "." && echo "$kind = date = $text ($ZZ)"
 798             last if $text;
 799         }
 800         if (not $text) {
 801             my $part; my $M="date";
 802             for (source($ZZ)) {
 803                 /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 804                 $part=trimm($_); last;
 805             }
 806             $text=$part; $text =~ s|^[$AA]*:||;
 807             $text = &trimm ($text);
 808         }
 809         if (not $text) {
 810             my $part; my $M="!--date:*=*--"; # takeover updateable variable...
 811             for (source($ZZ)) {
 812                 /<$M>/ or next; s|.*<$M>||; s|</.*||;
 813                 $part=trimm($_); last;
 814             }
 815             $text=$part; $text =~ s|^[$AA]*:||; $text =~ s|\&.*||;
 816             $text = &trimm ($text);
 817         }
 818         $text =~ s/[$NN]*:.*//; # cut way seconds
 819         &DX_text ("updated", $text);
 820         my $text1=$text; $text1 =~ s|^.* *updated ||;
 821         if ($text ne $text1) {
 822             $kind="modified" ; $text=$text1; $text =~ s|,.*||;
 823         }
 824         $text1=$text; $text1 =~ s|^.* *modified ||;
 825         if ($text ne $text1) {
 826             $kind="modified" ; $text=$text1; $text =~ s|,.*||;
 827         }
 828         $text1=$text; $text1 =~ s|^.* *created ||;
 829         if ($text ne $text1) {
 830             $kind="created" ; $text=$text1; $text =~ s|,.*||;
 831         }
 832         &DC_meta ("date", "$text");
 833         &DX_text ("issue", "$kind $text");
 834     }
 835 }
 836
 837 sub DC_title
 838 {
 839     # choose a title for the document, either an explicit title-tag
 840     # or one of the section headers in the document or fallback to filename
 841     my ($ZZ,$Z) = @_; # target file
 842     my ($term, $text);
 843     if (not &info1grep ("DC.title")) {
 844         for my $M (qw/TITLE title H1 h1 H2 h2 H3 H3 H4 H4 H5 h5 H6 h6/) {
 845             for (source($ZZ)) {
 846                 /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 847                 $text = trimm($_); last;
 848             }
 849             last if $text;
 850             for (source($ZZ)) {
 851                 /<$M [^<>]*>/ or next; s|.*<$M [^<>]*>||; s|</$M>.*||;
 852                 $text = trimm($_); last;
 853             }
 854             last if $text;
 855         }
 856         if (not $text) {
 857             $text=basename($ZZ,".html");
 858             $text=basename($text,".htm"); $text =~ y/_/ /; $text =~ s/$/ info/;
 859             $text=~ s/\n/      /g;
 860         }
 861         $term=$text; $term =~ s/.*[\(]//; $term =~ s/[\)].*//;
 862         $text =~ s/[\(][^\(\)]*[\)]//;
 863         if (not $term or $term eq $text) {
 864             &DC_meta ("title", "$text");
 865         } else {
 866             &DC_meta ("title", "$term - $text");
 867         }
 868     }
 869 }
 870
 871 sub site_get_section # return parent section page of given page
 872 {
 873     my $_F_ = &sed_slash_key(@_);
 874     for my $x (grep {/<$Q='sect'>$_F_ /} @MK_DATA) {
 875         my $info = $x; $info =~ s|<$Q='sect'>[^ ]* ||; $info =~ s|<$QX>||;
 876         return $info;
 877     }
 878 }
 879
 880 sub DC_section # not really a DC relation (shall we use isPartOf ?)
 881 {                 # each document should know its section father
 882     my $sectn = &site_get_section($F);
 883     if ($sectn) {
 884         &DC_meta ("relation.section", $sectn);
 885     }
 886 }
 887
 888 sub info_get_entry_section
 889 {
 890     return &info_get_entry("DC.relation.section");
 891 }
 892
 893 sub site_get_selected  # return section of given page
 894 {
 895     my $_F_ = &sed_slash_key(@_);
 896     for my $x (grep {/<$Q='[u]se.'>$_F_ /} @MK_DATA) {
 897         my $info = $x;
 898         $info =~ s/<$Q='[u]se.'>[^ ]* //; $info =~ s|<$QX>||;
 899         return $info;
 900     }
 901 }
 902
 903 sub DC_selected # not really a DC title (shall we use alternative ?)
 904 {
 905     # each document might want to highlight the currently selected item
 906     my $short=&site_get_selected($F);
 907     if ($short) {
 908         &DC_meta ("title.selected", $short);
 909     }
 910 }
 911
 912 sub info_get_entry_selected
 913 {
 914     return &info_get_entry("DC.title.selected");
 915 }
 916
 917 sub site_get_rootsections # return all sections from root of nav tree
 918 {
 919     my @OUT;
 920     for (grep {/<$Q='[u]se1'>/} @MK_DATA) {
 921         my $x = $_;
 922         $x =~ s/<$Q='[u]se.'>([^ ]*) .*/$1/;
 923         push @OUT, $x;
 924     }
 925     return @OUT;
 926 }
 927
 928 sub site_get_sectionpages # return all children pages in the given section
 929 {
 930     my $_F_=&sed_slash_key(@_);
 931     my @OUT = ();
 932     for (grep {/^<$Q='sect'>[^ ]* $_F_$/} @MK_DATA) {
 933         my $x = $_;
 934         $x =~ s/^<$Q='sect'>//; $x =~ s/ .*//; $x =~ s|<$QX>||;
 935         push @OUT, $x;
 936     }
 937     return @OUT;
 938 }
 939
 940 sub site_get_subpages # return all page children of given page
 941 {
 942     my $_F_=&sed_slash_key(@_);
 943     my @OUT = ();
 944     for (grep {/^<$Q='node'>[^ ]* $_F_<[^<>]*>$/} @MK_DATA) {
 945         my $x = $_;
 946         $x =~ s/^<$Q='node'>//; $x =~ s/ .*//; $x =~ s|<$QX>||;
 947         push @OUT, $x;
 948     }
 949     return @OUT;
 950 }
 951
 952 sub site_get_parentpage # ret parent page for given page (".." for sections)
 953 {
 954     my $_F_=&sed_slash_key(@_);
 955     for (grep {/^<$Q='node'>$_F_ /} @MK_DATA) {
 956         my $x = $_;
 957         $x =~ s/^<$Q='node'>[^ ]* //; $x =~ s|<$QX>||;
 958         return $x;
 959     }
 960 }
 961
 962 sub DX_alternative    # detect wether page asks for alternative style
 963 {                        # which is generally a shortpage variant
 964     my ($U,$Z) = @_;
 965     my $x=&mksite_magic_option("alternative",$U);
 966     $x =~ s/^ *//; $x =~s/ .*//;
 967     if ($x) {
 968         &DX_text ("alternative", $x);
 969     }
 970 }
 971
 972 sub info2head_sed  # append alternative handling script to $HEAD
 973 {
 974     my @OUT = ();
 975     my $have=&info_get_entry("alternative");
 976     if ($have) {
 977         push @OUT, "/<!--mksite:alternative:$have .*-->/ && do {";
 978         push @OUT, "s/<!--mksite:alternative:$have( .*)-->/\$1/";
 979         push @OUT, "$sed_add \$_; last; };";
 980     }
 981     return @OUT;
 982 }
 983 sub info2body_sed  # append alternative handling script to $BODY
 984 {
 985     my @OUT = ();
 986     my $have=&info_get_entry("alternative");
 987     if ($have) {
 988         push @OUT, "s/<!--mksite:alternative:$have( .*)-->/\$1/";
 989     }
 990     return @OUT;
 991 }
 992
 993 sub bodymaker_for_sectioninfo
 994 {
 995     if ($sectioninfo eq "no") { return ""; }
 996     my $_x_="<!--mksite:sectioninfo::-->";
 997     my $_q_="([^<>]*[$AX][^<>]*)";
 998     $_q_="[ ][ ]*$sectioninfo([ ])" if $sectioninfo ne " ";
 999     my @OUT = ();
1000     push @OUT, "s|(^<[hH][$NN][ >].*</[hH][$NN]>)$_q_|\$1$_x_\$2|";
1001     push @OUT, "/$_x_/ and s|^|<table width=\"100%\"><tr valign=\"bottom\"><td>|";
1002     push @OUT, "/$_x_/ and s|</[hH][$NN]>|&</td><td align=\"right\"><i>|";
1003     push @OUT, "/$_x_/ and s|\$|</i></td></tr></table>|";
1004     push @OUT, "s|$_x_||";
1005     return @OUT;
1006 }
1007
1008 sub fast_href  # args "$FILETOREFERENCE" "$FROMCURRENTFILE:$F"
1009 {   # prints path to $FILETOREFERENCE href-clickable in $FROMCURRENTFILE
1010     # if no subdirectoy then output is the same as input $FILETOREFERENCE
1011     my ($T,$R,$Z) = @_;
1012     my $S=&back_path ($R);
1013     if (not $S) {
1014         return $T;
1015     } else {
1016         my $t=$T;
1017         $t =~ s/^ *$//; $t =~ s/^\/.*//;
1018         $t =~ s/^[.][.].*//; $t =~ s/^\w*:.*//;
1019         if (not $t) { # don't move any in the pattern above
1020             return $T;
1021         } else {
1022             return "$S$T";   # prefixed with backpath
1023         }
1024     }
1025 }
1026
1027 sub make_back_path # "$FILE"
1028 {
1029     my ($R,$Z) = @_;
1030     my $S=&back_path ($R);
1031     my @OUT = ();
1032     return @OUT if $S !~ /^\.\./;
1033     push @OUT, "s|(<[^<>]*\\shref=\\\")(\\w[^<>:]*\\\"[^<>]*>)|\$1$S\$2|g;";
1034     push @OUT, "s|(<[^<>]*\\ssrc=\\\")(\\w[^<>:]*\\\"[^<>]*>)|\$1$S\$2|g;";
1035     return @OUT;
1036 }
1037
1038 # ============================================================== SITE MAP DATA
1039 # each entry needs atleast a list-title, a long-title, and a list-date
1040 # these are the basic information to be printed in the sitemap file
1041 # where it is bound the hierarchy of sect/subsect of the entries.
1042
1043 sub site_map_list_title # $file $text
1044 {
1045     my ($U,$V,$Z) = @_; chomp($U);
1046     push @MK_DATA, "<$Q='list'>$U ".trimm($V)."<$QX>";
1047 }
1048 sub info_map_list_title # $file $text
1049 {
1050     my ($U,$V,$Z) = @_; chomp($U);
1051     push @{$DATA{$U}}, "<$Q='list'>".trimm($V)."<$QX>";
1052 }
1053 sub site_map_long_title # $file $text
1054 {
1055     my ($U,$V,$Z) = @_; chomp($U);
1056     push @MK_DATA, "<$Q='long'>$U ".trimm($V)."<$QX>";
1057 }
1058 sub info_map_long_title # $file $text
1059 {
1060     my ($U,$V,$Z) = @_; chomp($U);
1061     push @{$DATA{$U}}, "<$Q='long'>".trimm($V)."<$QX>";
1062 }
1063 sub site_map_list_date # $file $text
1064 {
1065     my ($U,$V,$Z) = @_; chomp($U);
1066     push @MK_DATA, "<$Q='date'>$U ".trimm($V)."<$QX>";
1067 }
1068 sub info_map_list_date # $file $text
1069 {
1070     my ($U,$V,$Z) = @_; chomp($U);
1071     push @{$DATA{$U}}, "<$Q='date'>".trimm($V)."<$QX>";
1072 }
1073
1074 sub site_get_list_title
1075 {
1076     my ($U,$V,$Z) = @_;
1077     for (@MK_DATA) { if (m|^<$Q='list'>$U (.*)<$QX>|) { return $1; } } return "";
1078 }
1079 sub site_get_long_title
1080 {
1081     my ($U,$V,$Z) = @_;
1082     for (@MK_DATA) { if (m|^<$Q='long'>$U (.*)<$QX>|) { return $1; } } return "";
1083 }
1084 sub site_get_list_date
1085 {
1086     my ($U,$V,$Z) = @_;
1087     for (@MK_DATA) { if (m|^<$Q='date'>$U (.*)<$QX>|) { return $1; } } return "";
1088 }
1089
1090 sub siteinfo2sitemap# generate <name><page><date> addon sed scriptlet
1091 {                      # the resulting script will act on each item/line
1092                        # containing <!--"filename"--> and expand any following
1093                        # reference of <!--name--> or <!--date--> or <!--long-->
1094     my ($INP,$Z) = @_ ; $INP= \@MK_DATA if not $INP;
1095     my @OUT = ();
1096     my $_list_=
1097         sub{"s|(<!--\\\"$1\\\"-->.*)<name [^<>]*>.*</name>|\$1<name href=\\\"$1\\\">$2</name>|"};
1098     my $_date_=
1099         sub{"s|(<!--\\\"$1\\\"-->.*)<date>.*</date>|\$1<date>$2</date>|"};
1100     my $_long_=
1101         sub{"s|(<!--\\\"$1\\\"-->.*)<long>.*</long>|\$1<long>$2</long>|"};
1102
1103     for (@$INP) {
1104         my $info = $_;
1105         $info =~ s:<$Q='list'>([^ ]*) (.*)<$QX>:&$_list_:e;
1106         $info =~ s:<$Q='date'>([^ ]*) (.*)<$QX>:&$_date_:e;
1107         $info =~ s:<$Q='long'>([^ ]*) (.*)<$QX>:&$_long_:e;
1108         $info =~ /^s\|/ || next;
1109         push @OUT, $info;
1110     }
1111     return @OUT;
1112 }
1113
1114 sub make_multisitemap
1115 {  # each category gets its own column along with the usual entries
1116     my ($INPUTS,$Z)= @_ ; $INPUTS=\@MK_DATA if not $INPUTS;
1117     @MK_SITE = &siteinfo2sitemap(); # have <name><long><date> addon-sed
1118     my @OUT = ();
1119     my $_form_= sub{"<!--\"$2\"--><!--use$1--><long>$3</long><!--end$1-->"
1120                         ."<br><name href=\"$2\">$3</name><date>......</date>" };
1121     my $_tiny_="small><small><small" ; my $_tinyX_="small></small></small ";
1122     my $_tabb_="<br><$_tiny_> </$_tinyX_>" ; my $_bigg_="<big> </big>";
1123     push @OUT, "<table width=\"100%\"><tr><td> ".$n;
1124     for (grep {/<$Q='[Uu]se.'>/} @$INPUTS) {
1125         my $x = $_;
1126         $x =~ />\w\w\w\w*:/ and next; # name: http: ftp: mailto: ...
1127         $x =~ s|<$Q='[Uu]se(.)'>([^ ]*) (.*)<$QX>|&$_form_|e;
1128         $x = &eval_MK_LIST("multisitemap", $x, @MK_SITE);
1129         $x =~ /<name/ or next;
1130         $x =~ s|<!--[u]se1-->|</td><td valign=\"top\"><b>|;
1131         $x =~ s|<!--[e]nd1-->|</b>|;
1132         $x =~ s|<!--[u]se2-->|<br>|;
1133         $x =~ s|<!--[u]se.-->|<br>|; $x =~ s/<!--[^<>]*-->/ /g;
1134         $x =~ s|<name |<$_tiny_><a |; $x =~ s|</name>||;
1135         $x =~ s|<date>|<small style="date">|;
1136         $x =~ s|</date>|</small></a><br></$_tinyX_>|;
1137         $x =~ s|<long>|<!--long-->|;
1138         $x =~ s|</long>|<!--/long-->|;
1139         chomp $x;
1140         push @OUT, $x.$n;
1141     }
1142     push @OUT, "</td><tr></table>".$n;
1143     return @OUT;
1144 }
1145
1146 sub make_listsitemap
1147 {   # traditional - the body contains a list with date and title extras
1148     my ($INPUTS,$Z)= @_ ; $INPUTS=\@MK_DATA if not $INPUTS;
1149     @MK_SITE = &siteinfo2sitemap(); # have <name><long><date> addon-sed
1150     my @OUT = ();
1151     my $_form_=sub{
1152         "<!--\"$2\"--><!--use$1--><name href=\"$2\">$3</name><date>......</date><long>$3</long>"};
1153     my $_tabb_="<td>\&nbsp\;</td>";
1154     push @OUT, "<table cellspacing=\"0\" cellpadding=\"0\">".$n;
1155     my $xx;
1156     for $xx (grep {/<$Q='[Uu]se.'>/} @$INPUTS) {
1157         my $x = "".$xx;
1158         $x =~ />\w\w\w\w*:/ and next;
1159         $x =~ s|<$Q='[Uu]se(.)'>([^ ]*) (.*)<$QX>|&$_form_|e;
1160         $x = &eval_MK_LIST("listsitemap", $x, @MK_SITE);
1161         $x =~ /<name/ or next;
1162         $x =~ s|<!--[u]se(1)-->|<tr class=\"listsitemap$1\"><td>*</td>|;
1163         $x =~ s|<!--[u]se(2)-->|<tr class=\"listsitemap$1\"><td>-</td>|;
1164         $x =~ s|<!--[u]se(.)-->|<tr class=\"listsitemap$1\"><td> </td>|;
1165         $x =~  /<tr.class=\"listsitemap3\">/ and $x =~ s|(<name [^<>]*>)|$1- |;
1166         $x =~ s|<!--[^<>]*-->| |g;
1167         $x =~ s|<name href=\"name:sitemap:|<name href=\"|;
1168         $x =~ s|<name |<td><a |;     $x =~ s|</name>|</a></td>$_tabb_|;
1169         $x =~ s|<date>|<td><small style="date">|;
1170         $x =~ s|</date>|</small></td>$_tabb_|;
1171         $x =~ s|<long>|<td><em><!--long-->|;
1172         $x =~ s|</long>|<!--/long--></em></td></tr>|;
1173         push @OUT, $x.$n;
1174     }
1175     for $xx (grep {/<$Q='[u]se.'>/} @$INPUTS) {
1176         my $x = $xx;
1177         $x =~ s/<$Q='[u]se.'>name:sitemap://; $x =~ s|<$QX>||; $x =~ s:\s*::gs;
1178         if (-f $x) {
1179             for (grep {/<tr.class=\"listsitemap\d\">/} source($x)) {
1180                 push @OUT, $_;
1181             }
1182         }
1183     }
1184     push @OUT, "</table>".$n;
1185     return @OUT;
1186 }
1187
1188 my $_xi_include_=
1189     "<xi:include xmlns:xi=\"http://www.w3.org/2001/XInclude\" parse=\"xml\"";
1190
1191 sub make_xmlsitemap
1192 {   # traditional - the body contains a list with date and title extras
1193     my ($INPUTS,$Z)= @_ ; $INPUTS=\@MK_DATA if not $INPUTS;
1194     @MK_SITE = &siteinfo2sitemap(); # have <name><long><date> addon-sed
1195     my @OUT = ();
1196     my $_form_=sub{"<!--\"$2\"--><name href=\"$2\">$3</name>"};
1197     my $xx;
1198     for $xx (grep {/<$Q='[Uu]se.'>/} @$INPUTS) {
1199         my $x = "".$xx;
1200         $x =~ />\w\w\w\w*:/ and next;
1201         $x =~ s|<$Q='[Uu]se(.)'>([^ ]*) (.*)<$QX>|&$_form_|e;
1202         $x = &eval_MK_LIST("listsitemap", $x, @MK_SITE);
1203         $x =~ /<name/ or next;
1204         $x =~ m|href="${SITEFILE}"| and next;
1205         $x =~ m|href="${SITEFILE}l"| and next;
1206         $x =~ s|(href="[^<>]*)\.html(")|$1.xml$2|g;
1207         $x =~ s|.*<name|$_xi_include_$n   |;
1208         $x =~ s|>.*</name>| />|;
1209         push @OUT, $x.$n;
1210     }
1211     return @OUT;
1212 }
1213
1214 sub print_extension
1215 {
1216     my ($ARG,$Z)= @_ ; $ARG=$o{print} if not $ARG;
1217     if ($ARG =~ /^([.-])/) {
1218         return $ARG;
1219     } else {
1220         return ".print";
1221     }
1222 }
1223
1224 sub from_sourcefile
1225 {
1226     my ($U,$Z) = @_;
1227     if (-f $U) {
1228         return $U;
1229     } elsif (-f "$o{src_dir}/$U") {
1230         return "$o{src_dir}/$U";
1231     } else {
1232         return $U;
1233     }
1234 }
1235
1236 sub html_sourcefile  # generally just cut away the trailing "l" (ell)
1237 {                    # making "page.html" argument into "page.htm" return
1238     my ($U,$Z) = @_;
1239     my $_SRCFILE_=$U; $_SRCFILE_ =~ s/l$//;
1240     my $_XMLFILE_=$U; $_XMLFILE_ =~ s/\.html$/.dbk/;
1241     if (-f $_SRCFILE_) {
1242         return $_SRCFILE_;
1243     } elsif (-f $_XMLFILE_) {
1244         return $_XMLFILE_;
1245     } elsif (-f "$o{src_dir}/$_SRCFILE_") {
1246         return "$o{src_dir}/$_SRCFILE_";
1247     } elsif (-f "$o{src_dir}/$_XMLFILE_") {
1248         return "$o{src_dir}/$_XMLFILE_";
1249     } else {
1250         return ".//$_SRCFILE_";
1251     }
1252 }
1253 sub html_printerfile_sourcefile
1254 {
1255     my ($U,$Z) = @_;
1256     if (not $printerfriendly) {
1257         $U =~ s/l\$//; return $U;
1258     } else {
1259         my $_ext_=&sed_slash_key(&print_extension($printerfriendly));
1260         $U =~ s/l\$//; $U =~ s/$_ext_([.][\w]*)$/$1/; return $U;
1261     }
1262 }
1263
1264 sub fast_html_printerfile {
1265     my ($U,$V,$Z) = @_;
1266     my $x=&html_printerfile($U) ; return basename($x);
1267 #   my $x=&html_printerfile($U) ; return &fast_href($x,$V);
1268 }
1269
1270 sub html_printerfile # generate the printerfile for a given normal output
1271 {
1272     my ($U,$Z) = @_;
1273     my $_ext_=&esc(&print_extension($printerfriendly));
1274     $U =~ s/([.][\w]*)$/$_ext_$1/; return $U; # index.html -> index.print.html
1275 }
1276
1277 sub make_printerfile_fast # generate s/file.html/file.print.html/ for hrefs
1278 {                        # we do that only for the $FILELIST
1279     my ($U,$Z) = @_;
1280     my $ALLPAGES=$U;
1281     my @OUT = ();
1282     for my $p (@$ALLPAGES) {
1283         my $a=&sed_slash_key($p);
1284         my $b=&html_printerfile($p);
1285         if ($b ne $p) {
1286             $b =~ s:/:\\/:g;
1287             push @OUT,
1288             "s/<a href=\\\"$a\\\"([^<>])*>/<a href=\\\"$b\\\"\$1>/;";
1289         }
1290     }
1291     return @OUT;
1292 }
1293
1294 sub echo_printsitefile_style
1295 {
1296     my $_bold_="text-decoration : none ; font-weight : bold ; ";
1297     return "   <style>"
1298         ."$n     a:link    { $_bold_ color : #000060 ; }"
1299         ."$n     a:visited { $_bold_ color : #000040 ; }"
1300         ."$n     body      { background-color : white ; }"
1301         ."$n   </style>"
1302         ."$n";
1303 }
1304
1305 sub make_printsitefile_head # $sitefile
1306 {
1307     my $MK_STYLE = &echo_printsitefile_style();
1308     my @OUT = ();
1309     for (source($SITEFILE)) {
1310         if (/<head>/) {  push @OUT, $_;
1311                          push @OUT, $MK_STYLE; next; }
1312         if (/<title>/) { push @OUT, $_; next; }
1313         if (/<\/head>/) { push @OUT, $_; next; }
1314         if (/<body>/) { push @OUT, $_; next; }
1315         if (/<link [^<>]*rel=\"shortcut icon\"[^<>]*>/) {
1316             push @OUT, $_; next;
1317         }
1318     }
1319     return @OUT;
1320 }
1321
1322 # ------------------------------------------------------------------------
1323 # The printsitefile is a long text containing html href markups where
1324 # each of the href lines in the file is being prefixed with the section
1325 # relation. During a secondary call the printsitefile can grepp'ed for
1326 # those lines that match a given output fast-file. The result is a
1327 # navigation header with 1...3 lines matching the nesting level
1328
1329 # these alt-texts will be only visible in with a text-mode browser:
1330 my $printsitefile_square="width=\"8\" height=\"8\" border=\"0\"";
1331 my $printsitefile_img_1="<img alt=\"|go text:\" $printsitefile_square />";
1332 my $printsitefile_img_2="<img alt=\"||topics:\" $printsitefile_square />";
1333 my $printsitefile_img_3="<img alt=\"|||pages:\" $printsitefile_square />";
1334 my $_SECT="mksite:sect:";
1335
1336 sub echo_current_line # $sect $extra
1337 {
1338     # add the prefix which is used by select_in_printsitefile to cut out things
1339     my ($N,$M,$Z) = @_;
1340     return "<!--$_SECT\"$N\"-->$M";
1341 }
1342 sub make_current_entry # $sect $file      ## requires $MK_SITE
1343 {
1344     my ($S,$R,$Z) = @_;
1345     my $RR=&sed_slash_key($R);
1346     my $sep=" - " ; my $_left_=" [ " ; my $_right_=" ] ";
1347     my $name = site_get_list_title($R);
1348     $_ = &echo_current_line ("$S", "<a href=\"$R\">$name</a>$sep");
1349     if ($R eq $S) {
1350         s/<a href/$_left_$&/;
1351         s/<\/a>/$&$_right_/;
1352     }
1353     return $_;
1354 }
1355 sub echo_subpage_line # $sect $extra
1356 {
1357     my ($N,$M,$Z) = @_;
1358     return "<!--$_SECT*:\"$N\"-->$M";
1359 }
1360
1361 sub make_subpage_entry
1362 {
1363     my ($S,$R,$Z) = @_;
1364     my $RR=&sed_slash_key($R);
1365     my $sep=" - " ;
1366     my $name = site_get_list_title($R);
1367     $_ = &echo_subpage_line ("$S", "<a href=\"$R\">$name</a>$sep");
1368     return $_;
1369 }
1370
1371 sub make_printsitefile
1372 {
1373    # building the printsitefile looks big but its really a loop over sects
1374     my ($INPUTS,$Z) = @_; $INPUTS=\@MK_DATA if not $INPUTS;
1375     @MK_SITE = &siteinfo2sitemap(); # have <name><long><date> addon-sed
1376     savelist(\@MK_SITE,"SITE");
1377
1378     my @OUT = &make_printsitefile_head ($SITEFILE);
1379     my $sep=" - " ;
1380     my $_sect1=
1381         "<a href=\"#.\" title=\"section\">$printsitefile_img_1</a> ||$sep";
1382     my $_sect2=
1383         "<a href=\"#.\" title=\"topics\">$printsitefile_img_2</a> ||$sep";
1384     my $_sect3=
1385         "<a href=\"#.\" title=\"pages\">$printsitefile_img_3</a> ||$sep";
1386
1387     my $_SECT1="mksite:sect1";
1388     my $_SECT2="mksite:sect2";
1389     my $_SECT3="mksite:sect3";
1390
1391     @MK_SECT1 = &site_get_rootsections();
1392     # round one - for each root section print a current menu
1393     for my $r (@MK_SECT1) {
1394         push @OUT, &echo_current_line ("$r", "<!--$_SECT1:A--><br>$_sect1");
1395         for my $s (@MK_SECT1) {
1396             push @OUT, &make_current_entry ("$r", "$s");
1397         }
1398         push @OUT, &echo_current_line ("$r", "<!--$_SECT1:Z-->");
1399     }
1400
1401     # round two - for each subsection print a current and subpage menu
1402     for my $r (@MK_SECT1) {
1403     @MK_SECT2 = &site_get_subpages ("$r");
1404     for my $s (@MK_SECT2) {
1405         push @OUT, &echo_current_line ("$s", "<!--$_SECT2:A--><br>$_sect2");
1406         for my $t (@MK_SECT2) {
1407             push @OUT, &make_current_entry ("$s", "$t");
1408         } # "$t"
1409         push @OUT, &echo_current_line  ("$s", "<!--$_SECT2:Z-->");
1410     } # "$s"
1411         my $_have_children_="";
1412         for my $t (@MK_SECT2) {
1413             if (not $_have_children_) {
1414         push @OUT, &echo_subpage_line ("$r", "<!--$_SECT2:A--><br>$_sect2"); }
1415             $_have_children_ .= "1";
1416             push @OUT, &make_subpage_entry ("$r", "$t");
1417         }
1418             if ($_have_children_) {
1419         push @OUT, &echo_subpage_line ("$r", "<!--$_SECT2:Z-->"); }
1420     } # "$r"
1421
1422     # round three - for each subsubsection print a current and subpage menu
1423     for my $r (@MK_SECT1) {
1424     @MK_SECT2 = &site_get_subpages ("$r");
1425     for my $s (@MK_SECT2) {
1426     @MK_SECT3 = &site_get_subpages ("$s");
1427     for my $t (@MK_SECT3) {
1428         push @OUT, &echo_current_line ("$t", "<!--$_SECT3:A--><br>$_sect3");
1429         for my $u (@MK_SECT3) {
1430             push @OUT, &make_current_entry ("$t", "$u");
1431         } # "$t"
1432         push @OUT, &echo_current_line  ("$t", "<!--$_SECT3:Z-->");
1433     } # "$t"
1434         my $_have_children_="";
1435         for my $u (@MK_SECT3) {
1436             if (not $_have_children_) {
1437         push @OUT, &echo_subpage_line ("$s", "<!--$_SECT3:A--><br>$_sect3"); }
1438             $_have_children_ .= "1";
1439             push @OUT, &make_subpage_entry ("$s", "$u");
1440         }
1441             if ($_have_children_) {
1442         push @OUT, &echo_subpage_line ("$s", "<!--$_SECT3:Z-->"); }
1443     } # "$s"
1444     } # "$r"
1445     push @OUT, "<a name=\".\"></a>";
1446     push @OUT, "</body></html>";
1447     savelist(\@OUT,"FORM");
1448     return @OUT;
1449 }
1450
1451 # create a selector that can grep a printsitefile for the matching entries
1452 sub select_in_printsitefile # arg = "page" : return to stdout >> $P.$HEAD
1453 {
1454     my ($N,$Z) = @_;
1455     my $_selected_="$N" ; $_selected_="$F" if not $_selected_;
1456     my $_section_=&sed_slash_key($_selected_);
1457     my @OUT = ();
1458     push @OUT, "s/^<!--$_SECT\\\"$_section_\\\"-->//;";        # sect3
1459     push @OUT, "s/^<!--$_SECT\[*\]:\\\"$_section_\\\"-->//;";    # children
1460     $_selected_=&site_get_parentpage($_selected_);
1461     $_section_=&sed_slash_key($_selected_);
1462     push @OUT, "s/^<!--$_SECT\\\"$_section_\\\"-->//;";        # sect2
1463     $_selected_=&site_get_parentpage($_selected_);
1464     $_section_=&sed_slash_key($_selected_);
1465     push @OUT, "s/^<!--$_SECT\\\"$_section_\\\"-->//;";        # sect1
1466     push @OUT, "/^<!--$_SECT\\\"[^\\\"]*\\\"-->/ and next;";
1467     push @OUT, "/^<!--$_SECT\[*\]:\\\"[^\\\"]*\\\"-->/ and next;";
1468     push @OUT, "s/^<!--mksite:sect[$NN]:[$AZ]-->//;";
1469     return @OUT;
1470 }
1471
1472 sub body_for_emailfooter
1473 {
1474     return "" if $emailfooter eq "no";
1475     my $_email_=$emailfooter; $_email_ =~ s|[?].*||;
1476     my $_dated_=&info_get_entry("updated");
1477     return "<hr><table border=\"0\" width=\"100%\"><tr><td>"
1478         ."$n"."<a href=\"mailto:$emailfooter\">$_email_</a>"
1479         ."$n"."</td><td align=\"right\">"
1480         ."$n"."$_dated_</td></tr></table>"
1481         ."$n";
1482 }
1483
1484 # =================================================================== CSS
1485 # There was another project to support sitemap build from xml files.
1486 # The source format was using .dbk+xml with embedded references to .css
1487 # files for visual preview in a browser. An docbook xml file with semantic
1488 # outlines is far better suited for quality documentation than any html
1489 # source. It happens that the xml/css support in browsers is still not
1490 # very portable - especially embedded css style blocks are a nightmare.
1491 # Instead we (a) grab all non-html xml markup tags (b) grab all referenced
1492 # css stylesheets (c) cut out css defs from [b] that are known by [a] and
1493 # (d) append those to the <style> tag in the output html file as well as
1494 # (e) reformatting the defs as well as markups from tags to tag classes.
1495 # Input dbk/htm
1496 #  <?xml-stylesheet type="text/css" href="html.css" ?>         <!-- dbk/xml -->
1497 #  <link rel="stylesheet" type="text/css" href="sdocbook.css" /> <!-- xhtml -->
1498 #  <article><para>
1499 #  Using some <command>exe</command>
1500 #  </para></article>
1501 # Input css:
1502 #  article { .. ; display : block }
1503 #  para { .. ; display : block }
1504 #  command { .. ; display : inline }
1505 # Output html:
1506 #  <html><style type="text/css">
1507 #  div .article { .. }
1508 #  div .para { .. }
1509 #  span .command { .. }
1510 #  </style>
1511 #  <div class="article"><div class="para>
1512 #  Using some <span class="command">exe</span>
1513 #  </div></div>
1514
1515 sub css_sourcefile
1516 {
1517     my ($X,$XXX) = @_;
1518     return $X if -f $X;
1519     return "$o{src_dir}/$X" if -f "$o{src_dir}/$X";
1520     return "$X" if "$X" =~ m:^/:;
1521     return "./$X";
1522 }
1523
1524 my %XMLTAGS = ();
1525 sub css_xmltags # $SOURCEFILE
1526 {
1527     my $X=$SOURCEFILE;
1528     my %R = ();
1529     my $line;
1530     foreach $line (source($SOURCEFILE)) {
1531         $line =~ s|>[^<>]*<|><|g;
1532         $line =~ s|^[^<>]*<|<|;
1533         $line =~ s|>[^<>]*\$|>|;
1534         my $item;
1535         foreach $item (split /</, $line) {
1536             $item =~ m:^/: and next;
1537             $item =~ m:^\s*$: and next;
1538             $item !~ m|>| and next;
1539             $item =~ s|>.*||;
1540             chomp $item;
1541             $R{$item} = "";
1542         }
1543     }
1544     @{$XMLTAGS{$X}} = keys %R;
1545 }
1546
1547 my %XMLSTYLESHEETS = ();
1548 sub css_xmlstyles # $SOURCEFILE
1549 {
1550     my $X=$SOURCEFILE;
1551     my %R = ();
1552     my $text = "";
1553     my $line = "";
1554     foreach $line (source($SOURCEFILE)) {
1555         $text .= $line;
1556         $text =~ s|<link  *rel=[\'\"]*stylesheet|<?xml-stylesheet |;
1557         if ($text !~ m/<.xml-stylesheet/) { $text = ""; next; }
1558         if ($text !~ m/href=/) { next; }
1559         $text =~ s|^.*<.xml-stylesheet||;
1560         $text =~ s|^.*href=[\"\']||; $text =~ s|[\"\'].*||s;
1561         chomp $text;
1562         $R{$text} = "";
1563     }
1564     foreach $line (source($SITEFILE)) {
1565         $text .= $line;
1566         $text =~ s|<link  *rel=[\'\"]*stylesheet|<?xml-stylesheet |;
1567         if ($text !~ m/<.xml-stylesheet/) { $text = ""; next; }
1568         if ($text !~ m/href=/) { next; }
1569         $text =~ s|^.*<.xml-stylesheet||;
1570         $text =~ s|^.*href=[\"\']||; $text =~ s|[\"\'].*||s;
1571         chomp $text;
1572         $R{$text} = "";
1573     }
1574     @{$XMLSTYLESHEETS{$X}} = keys %R;
1575 }
1576
1577 my %XMLTAGSCSS = ();
1578 sub css_xmltags_css # $SOURCEFILE
1579 {
1580     my $X=$SOURCEFILE;
1581     my @S = $XMLTAGS{$X};
1582     my @R = ();
1583     my $xmlstylesheet;
1584     foreach $xmlstylesheet (@{$XMLSTYLESHEETS{$X}}) {
1585         my $stylesheet = css_sourcefile($xmlstylesheet);
1586         if (-f $stylesheet) {
1587             push @R, "/* $xmlstylesheet */";
1588             my $text = "";
1589             my $line = "";
1590             my $STYLESHEET = $stylesheet;
1591             open STYLESHEET, "<$STYLESHEET" or next;
1592             foreach $line (<STYLESHEET>)
1593             {
1594                 $text .= $line;
1595                 if ($text =~ /^[^\{]*\}/s) { $text = ""; next; }
1596                 if ($text !~ /^[^\{]*\{.*\}/s) { next; }
1597                 $text =~ s|\r||g;
1598                 my $xmltag; my $found = 0;
1599                 foreach $xmltag (grep /^\w/, @{$XMLTAGS{$X}}) {
1600                     $xmltag =~ s| .*||;
1601                     if (grep {$_ eq $xmltag} qw/title section/) {
1602                         next if $xmltag eq "section";
1603                         $found++ if $text =~
1604                             /\b$xmltag\s*(?:,[^{},]*)*\s*\{/s;
1605                         my $xmlparent;
1606                         foreach $xmlparent (@{$XMLTAGS{$X}}) {
1607                             $xmlparent =~ s| .*||;
1608                             /^\w/ or next;
1609                             $found++ if $text =~
1610                                 /\b$xmlparent\s+$xmltag\s*(?:,[^{},]*)*\s*\{/s;
1611                         }
1612                     } else {
1613                         $found++ if $text =~
1614                             /\b$xmltag\s*(?:,[^\{\},]*)*\{/s;
1615                     }
1616                     last if $found;
1617                 }
1618                 if (not $found) { $text = ""; next; }
1619                 foreach $xmltag (grep /^\w/, @{$XMLTAGS{$X}}) {
1620                     $xmltag =~ s| .*||;
1621                     if (grep {$_ eq $xmltag} @HTMLTAGS) { next; }
1622                     if (grep {$_ eq $xmltag} @HTMLTAGS2) { next; }
1623                     $text =~ s/(\b$xmltag\s*(?:,[^{},]*)*\s*\{)/.$1/gs;
1624                 }
1625                 chomp $text;
1626                 push @R, $text; $text = ""; next;
1627             }
1628         } else {
1629             warn "$xmlstylesheet : ERROR, no such stylesheet $xmlstylesheet";
1630         }
1631     }
1632     @{$XMLTAGSCSS{$X}} = @R;
1633 }
1634
1635 my %XMLMAPPING = ();
1636 sub css_xmlmapping # $SOURCEFILE
1637 {
1638     my $X=$SOURCEFILE;
1639     my %R = ();
1640     foreach (@{$XMLTAGSCSS{$X}}) {
1641         my $span = "";
1642         $span="li"      if /\bdisplay\s*:\s*list-item\b/;
1643         $span="caption" if /\bdisplay\s*:\s*table-caption\b/;
1644         $span="td"      if /\bdisplay\s*:\s*table-cell\b/;
1645         $span="tr"      if /\bdisplay\s*:\s*table-row\b/;
1646         $span="table"   if /\bdisplay\s*:\s*table\b/;
1647         $span="div"     if /\bdisplay\s*:\s*block\b/;
1648         $span="span"    if /\bdisplay\s*:\s*inline\b/;
1649         $span="small"    if /\bdisplay\s*:\s*none\b/;
1650         $span="ul"  if /\blist-style-type\s*:\s*disc\b/    and $span eq "div";
1651         $span="ol"  if /\blist-style-type\s*:\s*decimal\b/ and $span eq "div";
1652         $span="tt"  if /\bfont-family\s*:\s*monospace\b/   and $span eq "span";
1653         $span="em"  if /\bfont-style\s*:\s*italic\b/       and $span eq "span";
1654         $span="b"   if /\bfont-weight\s*:\s*bold\b/        and $span eq "span";
1655         $span="pre" if /\bwhite-space\s*:\s*pre\b/         and $span eq "div";
1656         my $xmltag;
1657         for $xmltag (grep /^\w/, @{$XMLTAGS{$X}}) {
1658             $xmltag =~ s| .*||;
1659             if (/\.$xmltag\b/s) {
1660                 $R{$xmltag} = $span;
1661                 $R{$xmltag} = "p" if $xmltag eq "para" and $span eq "div";
1662                 $R{$xmltag} = "a" if $xmltag eq "ulink" and $span eq "span";
1663             }
1664         }
1665     }
1666     %{$XMLMAPPING{$X}} = %R;
1667 }
1668
1669 sub css_scan # $SOURCEFILE
1670 {
1671     css_xmltags ();
1672     css_xmlstyles ();
1673     css_xmltags_css ();
1674     css_xmlmapping ();
1675 }
1676
1677 sub tags2span_sed # $SOURCEFILE > $++
1678 {
1679     my $X=$SOURCEFILE;
1680     my $xmltag;
1681     my @R = ();
1682     push @R, "s|<[?]xml-stylesheet[^<>]*[?]>||";
1683     push @R, "s|<link  *rel=['\"]*stylesheet[^<>]*>||";
1684     push @R, "s|<section[^<>]*>||g;";
1685     push @R, "s|</section[^<>]*>||g;";
1686     for $xmltag (grep /^\w/, @{$XMLTAGS{$X}}) {
1687         $xmltag =~ s| .*||;
1688         if (grep {$_ eq $xmltag} @HTMLTAGS) { next; }
1689         if (grep {$_ eq $xmltag} @HTMLTAGS2) { next; }
1690         my $span = $XMLMAPPING{$X}{$xmltag};
1691         $span = "span" if $span eq "";
1692         push @R, "s|<$xmltag([\\n\\t ][^<>]*)url=|<$span class=\"$xmltag\"\$1href=|g;";
1693         push @R, "s|<$xmltag([\\n\\t >])|<$span class=\"$xmltag\"\$1|g;";
1694         push @R, "s|</$xmltag([\\n\\t >])|</$span\$1|g;";
1695     }
1696     my $xmlstylesheet;
1697     foreach $xmlstylesheet (@{$XMLSTYLESHEETS{$X}}) {
1698         my $H="[^<>]*href=[\'\"]${xmlstylesheet}[\'\"][^<>]*";
1699         push @R, "s|<[?]xml-stylesheet$H>||;";
1700         push @R, "s|<link[^<>]* rel=['\"]*stylesheet['\"]$H>||;";
1701     }
1702     return @R;
1703 }
1704
1705 sub tags2meta_sed # $SOURCEFILE > $++
1706 {
1707     my @R = ();
1708     push @R, " <style type=\"text/css\"><!--";
1709     push @R, map {s/(^|\n)/$1  /g;$_} @{$XMLTAGSCSS{$SOURCEFILE}};
1710     push @R, " --></style>";
1711     @R = () if $#R < 3;
1712     return @R;
1713 }
1714
1715 # ==========================================================================
1716 # xml/docbook support is taking an dbk input file converting any html    DBK
1717 # syntax into pure docbook tagging. Each file is being given a docbook
1718 # doctype so that an xml/docbook viewer can render it correctly - that
1719 # is needed atleast since docbook files do not embed stylesheet infos.
1720 # Most of the processing is related to remap html markup and some other
1721 # shortcut markup into correct docbook markup. The result is NOT checked
1722 # for being well-formed or even matching the docbook schema DTD at all.
1723
1724 sub scan_xml_rootnode
1725 {
1726     my ($INF,$XXX) = @_;
1727     $INF = \@{$DATA{$F}} if not $INF;
1728     for my $entry (source($SOURCEFILE)) {
1729         my $line = $entry; next if $line !~ /<\w/;
1730         $line =~ s/<(\w*).*/$1/s;
1731         # print ":",$line,$n;
1732         push @{$INF}, "<!root $F>$line";
1733         return;
1734     }
1735 }
1736
1737 sub get_xml_rootnode
1738 {
1739     my ($INF,$XXX) = @_;
1740     $INF = \@{$DATA{$F}} if not $INF;
1741     my $_file_ = sed_slash_key($F);
1742     foreach my $entry (grep /^<!root $_file_>/, @{$INF}) {
1743         my $line=$entry; $line =~ s|.*>||;
1744         return $line;
1745     }
1746 }
1747
1748 sub xml_sourcefile
1749 {
1750     my ($X,$XXX) = @_;
1751     my $XMLFILE=$X; $XMLFILE =~ s/\.xml$/.dbk/;
1752     my $SRCFILE=$X; $SRCFILE =~ s/\.xml$/.htm/;
1753     $XMLFILE="///" if $X eq $XMLFILE;
1754     $SRCFILE="///" if $X eq $SRCFILE;
1755     return $XMLFILE if -f $XMLFILE;
1756     return $SRCFILE if -f $SRCFILE;
1757     return "$o{src_dir}/$XMLFILE" if -f "$o{src_dir}/$XMLFILE";
1758     return "$o{src_dir}/$SRCFILE" if -f "$o{src_dir}/$SRCFILE";
1759     return ".//$XMLFILE"; # $++ (not found?)
1760 }
1761
1762 sub scan_xmlfile
1763 {
1764     $SOURCEFILE= &xml_sourcefile($F);
1765     hint "'$SOURCEFILE': scanning xml -> '$F'";
1766     scan_xml_rootnode();
1767     my $rootnode=&get_xml_rootnode(); $rootnode =~ s|^(h\d.*$)|$1 <?section?>|;
1768     hint "'$SOURCEFILE': rootnode ('$rootnode')";
1769 }
1770
1771 sub make_xmlfile
1772 {
1773     $SOURCEFILE= &xml_sourcefile($F);
1774     my $X=$SOURCEFILE;
1775     my $article= &get_xml_rootnode();
1776     $article="article" if $article eq "";
1777     my $text = "";
1778     $text .= '<!DOCTYPE '.$article.
1779         ' PUBLIC "-//OASIS//DTD DocBook XML V4.4//EN"'.$n;
1780     $text .= '    "http://www.oasis-open.org/docbook/xml/4.4/docbookx.dtd">'
1781         .$n;
1782     for my $stylesheet (@{$XMLSTYLESHEETS{$X}}) {
1783         $text .= "<?xml-stylesheet type=\"text/css\" href=\"$stylesheet\"   ?>"
1784             .$n;
1785     }
1786     for (source($SOURCEFILE)) {
1787         s!<>!\&nbsp\;!g;
1788         s!(&)(&)!${1}amp;${2}amp;!g;
1789         s!(<[^<>]*)(width)(=)(\d+\%*)!$1$2$3\"$4\"!g;
1790         s!(<[^<>]*)(cellpadding)(=)(\d+\%*)!$1$2$3\"$4\"!g;
1791         s!(<[^<>]*)(border)(=)(\d+\%*)!$1$2$3\"$4\"!g;
1792         s!<[?]xml-stylesheet[^<>]*>!!;
1793         s!<link[^<>]* rel=[\'\"]*stylesheet[^<>]*>!!;
1794         s!<[hH]\d!<title!g;
1795         s!</[hH]\d!</title!g;
1796         s!(</title> *)([^<>]*\w[^<>\r\n]*)$!$1<sub>$2</sub>!;
1797         s!(</title>.*)<sub>!$1<subtitle>!g;
1798         s!(</title>.*)</sub>!$1</subtitle>!g;
1799         s!(<section>[^<>]*)(<date>.*</date>[^<>\n]*)$!$1<sectioninfo>$2</sectioninfo>!gx;
1800         s!<em>!<emphasis>!g;
1801         s!</em>!</emphasis>!g;
1802         s!<i>!<emphasis>!g;
1803         s!</i>!</emphasis>!g;
1804         s!<b>!<emphasis role=\"bold\">!g;
1805         s!</b>!</emphasis>!g;
1806         s!<u>!<emphasis role=\"underline\">!g;
1807         s!</u>!</emphasis>!g;
1808         s!<big>!<emphasis role=\"strong\">!g;
1809         s!</big>!</emphasis>!g;
1810         s!<(s|strike)>!<emphasis role=\"strikethrough\">!g;
1811         s!</(s|strike)>!</emphasis>!g;
1812         s!<center>!<blockquote><para>!g;
1813         s!</center>!</para></blockquote>!g;
1814         s!<p align=(\"\w*\")>!<para role=${1}>!g;
1815         s!<[pP]>!<para>!g;
1816         s!</[pP]>!</para>!g;
1817         s!<(pre|PRE)>!<screen>!g;
1818         s!</(pre|PRE)>!</screen>!g;
1819         s!<a( [^<>]*)name=([^<>]*)/>!<anchor ${1}id=${2}/>!g;
1820         s!<a( [^<>]*)name=([^<>]*)>!<anchor ${1}id=${2}/>!g;
1821         s!<a( [^<>]*)href=!<ulink${1}url=!g;
1822         s!</a>!</ulink>!g;
1823         s! remap=\"url\">[^<>]*</ulink>! />!g;
1824         s!<(/?)span(\s[^<>]*)?>!<${1}phrase${2}>!g;
1825         s!<small(\s[^<>]*)?>!<phrase role=\"small\"${1}>!g;
1826         s!</small(\s[^<>]*)?>!</phrase${1}>!g;
1827         s!<(/?)(sup)>!<${1}superscript>!g;
1828         s!<(/?)(sub)>!<${1}subscript>!g;
1829         s!(<)(li)(><)!${1}listitem${3}!g;
1830         s!(></)(li)(>)!${1}listitem${3}!g;
1831         s!(<)(li)(>)!${1}listitem${3}<para>!g;
1832         s!(</)(li)(>)!</para>${1}listitem${3}!g;
1833         s!(</?)(ul)>!${1}itemizedlist>!g;
1834         s!(</?)(ol)>!${1}orderedlist>!g;
1835         s!(</?)(dl)>!${1}variablelist>!g;
1836         s!<(/?)DT>!<${1}dt>!g;
1837         s!<(/?)DD>!<${1}dd>!g;
1838         s!<(/?)DL>!<${1}dl>!g;
1839         s!<BLOCKQUOTE>!<blockquote><para>!g;
1840         s!</BLOCKQUOTE>!</para></blockquote>!g;
1841         s!<(/?)dl>!<${1}variablelist>!g;
1842         s!<dt\b([^<>]*)>!<varlistentry${1}><term>!g;
1843         s!</dt\b([^<>]*)>!</term>!g;
1844         s!<dd\b([^<>]*)><!<listitem${1}><!g;
1845         s!></dd\b([^<>]*)>!></listitem></varlistentry>!g;
1846         s!<dd\b([^<>]*)>!<listitem${1}><para>!g;
1847         s!</dd\b([^<>]*)>!</para></listitem></varlistentry>!g;
1848         s!<table[^<>]*><tr><td>(<table[^<>]*>)!$1!;
1849         s!(</table>)</td></tr></table>!$1!;
1850         s!<table\b([^<>]*)>!<informaltable${1}><tgroup cols=\"2\"><tbody>!g;
1851         s!</table\b([^<>]*)>!</tbody></tgroup></informaltable>!g;
1852         s!(</?)tr(\s[^<>]*)?>!${1}row${2}>!g;
1853         s!(</?)td(\s[^<>]*)?>!${1}entry${2}>!g;
1854         s!(<informaltable[^<>]*\swidth=\"100\%\")!$1 pgwide=\"1\"!g;
1855         s!(<tgroup[<>]*\scols=\"2\">)(<tbody>)
1856             !$1<colspec colwidth=\"1*\" /><colspec colwidth=\"1*\" />$2!gx;
1857         s!(<entry[^<>]*\s)width=(\"\d*\%*\")!${1}remap=${2}!g;
1858         s!<nobr>([\'\`]*)<tt>!<cmdsynopsis><command>$1!g;
1859         s!</tt>([\'\`]*)</nobr>!$1</command></cmdsynopsis>!g;
1860         s!<nobr><(tt|code)>([\`\"\'])!<cmdsynopsis><command>$2!g;
1861         s!<(tt|code)><nobr>([\`\"\'])!<cmdsynopsis><command>$2!g;
1862         s!([\`\"\'])</(tt|code)></nobr>!$1</command></cmdsynopsis>!g;
1863         s!([\`\"\'])</nobr></(tt|code)>!$1</command></cmdsynopsis>!g;
1864         s!(</?)tt>!${1}constant>!g;
1865         s!(</?)code>!${1}literal>!g;
1866         s!<br>!<br />!g;
1867         s!<br */>!<screen role=\"linebreak\">\n</screen>!g;
1868         $text .= $_;
1869     }
1870     open F, ">$F" or die "could not write $F: $!"; print F $text; close F;
1871     echo "'$SOURCEFILE': ",&ls_s($SOURCEFILE)," >> ",&ls_s($F);
1872 }
1873
1874 sub make_xmlmaster
1875 {
1876     $SOURCEFILE= &xml_sourcefile($F);
1877     my $X=$SOURCEFILE;
1878     my $article="section"; # book? chapter?
1879     my $text = "";
1880     $text .= '<!DOCTYPE '.$article.
1881         ' PUBLIC "-//OASIS//DTD DocBook XML V4.4//EN"'.$n;
1882     $text .= '    "http://www.oasis-open.org/docbook/xml/4.4/docbookx.dtd">'
1883         .$n;
1884     for my $stylesheet (@{$XMLSTYLESHEETS{$X}}) {
1885         $text .= "<?xml-stylesheet type=\"text/css\" href=\"$stylesheet\"   ?>"
1886             .$n;
1887     }
1888     # $text .= "<section><sectioninfo><date/><authorblurb/></sectioninfo>...";
1889     $text .= "<section><title>Documentation</title>$n";
1890     for (make_xmlsitemap()) {
1891         $text .= $_;
1892     }
1893     $text .= "</section>$n";
1894     open F, ">$F" or die "could not write $F: $!"; print F $text; close F;
1895     echo "'$SOURCEFILE': ",&ls_s($SOURCEFILE)," >*> ",&ls_s($F);
1896 }
1897
1898 # ==========================================================================
1899 #
1900 #  During processing we will create a series of intermediate files that
1901 #  store relations. They all have the same format being
1902 #   =relationtype=key value
1903 #  where key is usually s filename or an anchor. For mere convenience
1904 #  we assume that the source html text does not have lines that start
1905 #  off with =xxxx= (btw, ye remember perl section notation...). Of course
1906 #  any other format would be usuable as well.
1907 #
1908
1909 # we scan the SITEFILE for href references to be converted
1910 # - in the new variant we use a ".gets.tmp" sed script that            SECTS
1911 # marks all interesting lines so they can be checked later
1912 # with an sed anchor of sect="[$NN]" (or sect="[$AZ]")
1913 my $S="\\&nbsp\\;";
1914 # S="[&]nbsp[;]"
1915
1916 # HR and EM style markups must exist in input - BR sometimes left out
1917 # these routines in(ter)ject hardspace before, between, after markups
1918 # note that "<br>" is sometimes used with HR - it must exist in input
1919 sub echo_HR_EM_PP
1920 {
1921     my ($U,$V,$W,$X,$Z) = @_;
1922     my @list = (
1923                 "s%^($U$V$W*<a) (href=)%\$1 $X \$2%;",
1924                 "s%^(<>$U$V$W*<a) (href=)%\$1 $X \$2%;",
1925                 "s%^($S$U$V$W*<a) (href=)%\$1 $X \$2%;",
1926                 "s%^($U<>$V$W*<a) (href=)%\$1 $X \$2%;",
1927                 "s%^($U$S$V$W*<a) (href=)%\$1 $X \$2%;",
1928                 "s%^($U$V<>$W*<a) (href=)%\$1 $X \$2%;",
1929                 "s%^($U$V$S$W*<a) (href=)%\$1 $X \$2%;" );
1930     return @list;
1931 }
1932
1933 sub echo_br_EM_PP
1934 {
1935     my ($U,$V,$W,$X,$Z) = @_;
1936     my @list = &echo_HR_EM_PP  ("$U", "$V", "$W", "$X");
1937     my @listt = (
1938                  "s%^($V$W*<a) (href=)%\$1 $X \$2%;",
1939                  "s%^(<>$V$W*<a) (href=)%\$1 $X \$2%;",
1940                  "s%^($S$V$W*<a) (href=)%\$1 $X \$2%;",
1941                  "s%^($V<>$W*<a) (href=)%\$1 $X \$2%;",
1942                  "s%^($V$S$W*<a) (href=)%\$1 $X \$2%;",
1943                  "s%^($V$W*<><a) (href=)%\$1 $X \$2%;",
1944                  "s%^($V$W*$S<a) (href=)%\$1 $X \$2%;" );
1945     push @list, @listt;
1946     return @list;
1947 }
1948
1949 sub echo_HR_PP
1950 {
1951     my ($U,$V,$W,$Z) = @_;
1952     my @list = (
1953                 "s%^($U<a) (href=)%\$1 $W \$2%;",
1954                 "s%^($U$V*<a) (href=)%\$1 $W \$2%;",
1955                 "s%^(<>$U$V*<a) (href=)%\$1 $W \$2%;",
1956                 "s%^($S$U$V*<a) (href=)%\$1 $W \$2%;",
1957                 "s%^($U<>$V*<a) (href=)%\$1 $W \$2%;",
1958                 "s%^($U$S$V*<a) (href=)%\$1 $W \$2%;" );
1959     return @list;
1960 }
1961 sub echo_br_PP
1962 {
1963     my ($U,$V,$W,$Z) = @_;
1964     my @list = &echo_HR_PP ("$U", "$V", "$W");
1965     my @listt = (
1966                  "s%^($V*<a) (href=)%\$1 $W \$2%;",
1967                  "s%^(<>$V*<a) (href=)%\$1 $W \$2%;",
1968                  "s%^($S$V*<a) (href=)%\$1 $W \$2%;" );
1969     push @list, @listt;
1970     return @list;
1971 }
1972 sub echo_sp_PP
1973 {
1974     my ($U,$V,$Z) = @_;
1975     my @list = (
1976                 "s%^(<>$U*<a) (href=)%\$1 $V \$2%;",
1977                 "s%^($S$U*<a) (href=)%\$1 $V \$2%;",
1978                 "s%^(<><>$U*<a) (href=)%\$1 $V \$2%;",
1979                 "s%^($S$S$U*<a) (href=)%\$1 $V \$2%;",
1980                 "s%^(<>$U<>*<a) (href=)%\$1 $V \$2%;",
1981                 "s%^($S$U$S*<a) (href=)%\$1 $V \$2%;",
1982                 "s%^($U<><>*<a) (href=)%\$1 $V \$2%;",
1983                 "s%^($U$S$S*<a) (href=)%\$1 $V \$2%;",
1984                 "s%^($U<>*<a) (href=)%\$1 $V \$2%;",
1985                 "s%^($U$S*<a) (href=)%\$1 $V \$2%;" );
1986     return @list;
1987 }
1988 sub echo_sp_SP
1989 {
1990     my ($U,$V,$Z) = @_;
1991     my @list = (
1992                 "s%^($U<a) (href=)%\$1 $V \$2%;",
1993                 "s%^(<>$U<a) (href=)%\$1 $V \$2%;",
1994                 "s%^($S$U<a) (href=)%\$1 $V \$2%;",
1995                 "s%^(<><>$U<a) (href=)%\$1 $V \$2%;",
1996                 "s%^($S$S$U<a) (href=)%\$1 $V \$2%;",
1997                 "s%^(<>$U<><a) (href=)%\$1 $V \$2%;",
1998                 "s%^($S$U$S<a) (href=)%\$1 $V \$2%;",
1999                 "s%^($U<><><a) (href=)%\$1 $V \$2%;",
2000                 "s%^($U$S$S<a) (href=)%\$1 $V \$2%;",
2001                 "s%^($U<><a) (href=)%\$1 $V \$2%;",
2002                 "s%^($U$S<a) (href=)%\$1 $V \$2%;" );
2003     return @list;
2004 }
2005 sub echo_sp_sp
2006 {
2007     my ($U,$V,$Z) = @_;
2008     my @list = (
2009                 "s%^($U<a) (name=)%\$1 $V \$2%;",
2010                 "s%^(<>$U<a) (name=)%\$1 $V \$2%;",
2011                 "s%^($S$U<a) (name=)%\$1 $V \$2%;",
2012                 "s%^(<><>$U<a) (name=)%\$1 $V \$2%;",
2013                 "s%^($S$S$U<a) (name=)%\$1 $V \$2%;",
2014                 "s%^(<>$U<><a) (name=)%\$1 $V \$2%;",
2015                 "s%^($S$U$S<a) (name=)%\$1 $V \$2%;",
2016                 "s%^($U<><><a) (name=)%\$1 $V \$2%;",
2017                 "s%^($U$S$S<a) (name=)%\$1 $V \$2%;",
2018                 "s%^($U<><a) (name=)%\$1 $V \$2%;",
2019                 "s%^($U$S<a) (name=)%\$1 $V \$2%;" );
2020     return @list;
2021 }
2022
2023 sub make_sitemap_init
2024 {
2025     # build a list of detectors that map site.htm entries to a section table
2026     # note that the resulting .gets.tmp / .puts.tmp are real sed-script
2027     my $h1="[-|[]";
2028     my $b1="[*=]";
2029     my $b2="[-|[]";
2030     my $b3="[\\/:]";
2031     my $q3="[\\/:,[]";
2032     @MK_GETS = ();
2033     push @MK_GETS, &echo_HR_PP   ("<hr>",            "$h1",    "sect=\\\"1\\\"");
2034     push @MK_GETS, &echo_HR_EM_PP("<hr>","<em>",     "$h1",    "sect=\\\"1\\\"");
2035     push @MK_GETS, &echo_HR_EM_PP("<hr>","<strong>", "$h1",    "sect=\\\"1\\\"");
2036     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$b1$b1", "sect=\\\"1\\\"");
2037     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$b2$b2", "sect=\\\"2\\\"");
2038     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$b3$b3", "sect=\\\"3\\\"");
2039     push @MK_GETS, &echo_br_PP   ("<br>",          , "$b2$b2", "sect=\\\"2\\\"");
2040     push @MK_GETS, &echo_br_PP   ("<br>",          , "$b3$b3", "sect=\\\"3\\\"");
2041     push @MK_GETS, &echo_br_EM_PP("<br>","<small>" , "$q3"   , "sect=\\\"3\\\"");
2042     push @MK_GETS, &echo_br_EM_PP("<br>","<em>"    , "$q3"   , "sect=\\\"3\\\"");
2043     push @MK_GETS, &echo_br_EM_PP("<br>","<u>"     , "$q3"   , "sect=\\\"3\\\"");
2044     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$q3"   , "sect=\\\"3\\\"");
2045     push @MK_GETS, &echo_br_PP   ("<u>",           , "$b2"   , "sect=\\\"2\\\"");
2046     push @MK_GETS, &echo_sp_PP   (                   "$q3"   , "sect=\\\"3\\\"");
2047     push @MK_GETS, &echo_sp_SP   (                   ""      , "sect=\\\"2\\\"");
2048     push @MK_GETS, &echo_sp_sp   (                   "$q3"   , "sect=\\\"9\\\"");
2049     push @MK_GETS, &echo_sp_sp   ("<br>",                      "sect=\\\"9\\\"");
2050     @MK_PUTS = map { my $x=$_; $x =~ s/(>)(\[)/$1 *$2/; $x } @MK_GETS;
2051     # the .puts.tmp variant is used to <b><a href=..></b> some hrefs which
2052     # shall not be used otherwise for being generated - this is nice for
2053     # some quicklinks somewhere. The difference: a whitspace "<hr> <a...>"
2054 }
2055
2056 my $_uses_= sub{"<$Q='use$1'>$2 $3<$QX>" };
2057 my $_name_= sub{"<$Q='use$1'>name:$2 $3<$QX>" };
2058
2059 sub make_sitemap_list
2060 {
2061     my ($V,$Z) = @_; $V = $SITEFILE if not $V;
2062     # scan sitefile for references pages - store as "=use+=href+ anchortext"
2063     for (source($V)) {
2064         my $x = $_;
2065         local $_ = &eval_MK_LIST("sitemap_list", $x, @MK_GETS);
2066         /<a sect=\"[$NN]\"/ or next;
2067         chomp;
2068         s{.*<a sect=\"([^\"]*)\" href=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_uses_}e;
2069         s{.*<a sect=\"([^\"]*)\" name=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_name_}e;
2070         s{.*<a sect=\"([^\"]*)\" name=\"([^\"]*)\"[^<>]*>(.*)}{&$_name_}e;
2071         /^<$Q=/ or next;
2072         /^<!/ and next;
2073         push @MK_DATA, $_;
2074     }
2075 }
2076
2077 my $_Uses_= sub{"<$Q='Use$1'>$2 $3<$QX>" };
2078 my $_Name_= sub{"<$Q='Use$1'>name:$2 $3<$QX>" };
2079
2080 sub make_subsitemap_list # file-to-scan
2081 {
2082     my ($V,$W,$Z) = @_; $V = $SITEFILE if not $V;
2083     # scan sitefile for references pages - store as "=use+=href+ anchortext"
2084     for (source($V)) {
2085         my $x = $_;
2086         local $_ = &eval_MK_LIST("subsitemap_list", $x, @MK_GETS);
2087         /<a sect=\"[$NN]\"/ or next;
2088         chomp;
2089         s{.*<a sect=\"([^\"]*)\" href=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_Uses_}e;
2090         s{.*<a sect=\"([^\"]*)\" name=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_Name_}e;
2091         s{.*<a sect=\"([^\"]*)\" name=\"([^\"]*)\"[^<>]*>(.*)}{&$_Name_}e;
2092         /^<$Q=/ or next;
2093         /^<!/ and next;
2094         s|>([^:./][^:./]*[./])|>$W$1|;
2095         push @MK_DATA, $_;
2096     }
2097 }
2098
2099 sub make_sitemap_sect
2100 {
2101     # scan used pages and store prime section group relation =sect= and =node=
2102     # (A) each "use1" creates "=sect=href+ href1" for all following non-"use1"
2103     # (B) each "use1" creates "=node=href2 href1" for all following "use2"
2104     my $sect = "";
2105     for (grep {/<$Q='[u]se.'>/} @MK_DATA) {
2106         if (/<$Q='[u]se1'>([^ ]*) .*/) { $sect = $1; }
2107         my $x = $_; # chomp $x;
2108         $x =~ s|<$Q='[u]se.'>([^ ]*) .*|<$Q='sect'>$1 $sect<$QX>|;
2109         push @MK_DATA, $x;
2110     }
2111     for (grep {/<$Q='[u]se.'>/} @MK_DATA) {
2112         if (/<$Q='[u]se1'>([^ ]*) .*/) { $sect = $1; }
2113         /<$Q='[u]se[13456789]'>/ and next;
2114         my $x = $_; # chomp $x;
2115         $x =~ s|<$Q='[u]se.'>([^ ]*) .*|<$Q='node'>$1 $sect<$QX>|;
2116         push @MK_DATA, $x;
2117     }
2118 }
2119
2120 sub make_sitemap_page
2121 {
2122     # scan used pages and store secondary group relation =page= and =node=
2123     # the parenting =node= for use3 is usually a use2 (or use1 if none there)
2124     my $sect = "";
2125     for (grep {/<$Q='[u]se.'>/} @MK_DATA) {
2126         if (/<$Q='[u]se1'>([^ ]*) .*/) { $sect = $1; }
2127         if (/<$Q='[u]se2'>([^ ]*) .*/) { $sect = $1; }
2128         /<$Q='[u]se[1]'>/ and next;
2129         my $x = $_;
2130         $x =~ s|<$Q='[u]se.'>([^ ]*) .*|<$Q='page'>$1<$QX>|; chomp $x;
2131         push @MK_DATA, "$x $sect";
2132     }
2133     for (grep {/<$Q='[u]se.'>/} @MK_DATA) {
2134         if (/<$Q='[u]se1'>([^ ]*) .*/) { $sect = $1; }
2135         if (/<$Q='[u]se2'>([^ ]*) .*/) { $sect = $1; }
2136         /<$Q='[u]se[12456789]'>/ and next;
2137         my $x = $_;
2138         $x =~ s/<$Q='[u]se.'>([^ ]*) .*/<$Q='node'>$1<$QX>/; chomp $x;
2139         push @MK_DATA, "$x $sect"; ## print "(",$_,")","$x $sect", $n;
2140     }
2141     # and for the root sections we register ".." as the parenting group
2142     for (grep {/<$Q='[u]se1'>/} @MK_DATA) {
2143         my $x = $_; $x = trimm($x);
2144         $x =~ s/<$Q='[u]se.'>([^ ]*) .*/<$Q='node'>$1 ..<$QX>/; chomp $x;
2145         push @MK_DATA, $x;
2146     }
2147 }
2148 sub echo_site_filelist
2149 {
2150     my @OUT = ();
2151     for (grep {/<$Q='[u]se.'>/} @MK_DATA) {
2152         my $x = $_; $x =~ s/<$Q='[u]se.'>//; $x =~ s/ .*[\n]*//;
2153         push @OUT, $x;
2154     }
2155     return @OUT;
2156 }
2157
2158 # ==========================================================================
2159 # originally this was a one-pass compiler but the more information
2160 # we were scanning out the more slower the system ran - since we
2161 # were rescanning files for things like section information. Now
2162 # we scan the files first for global information.
2163 #                                                                    1.PASS
2164
2165 sub scan_sitefile # $F
2166 {
2167     $SOURCEFILE=&html_sourcefile($F);
2168     hint "'$SOURCEFILE': scanning -> sitefile";
2169     if ($SOURCEFILE ne $F) {
2170         dx_init "$F";
2171         dx_text ("today", &timetoday());
2172         my $short=$F;
2173         $short =~ s:.*/::; $short =~ s:[.].*::; # basename for all exts
2174         $short .=" ~";
2175         DC_meta ("title", "$short");
2176         DC_meta ("date.available", &timetoday());
2177         DC_meta ("subject", "sitemap");
2178         DC_meta ("DCMIType", "Collection");
2179         DC_VARS_Of ($SOURCEFILE) ; HTTP_VARS_Of ($SOURCEFILE) ;
2180         DC_modified ($SOURCEFILE) ; DC_date ($SOURCEFILE);
2181         DC_section ($F);
2182         DX_text ("date.formatted", &timetoday());
2183         if ($printerfriendly) {
2184             DX_text ("printerfriendly", fast_html_printerfile($F)); }
2185         if ($ENV{USER}) { DC_publisher ($ENV{USER}); }
2186         echo "'$SOURCEFILE': $short (sitemap)";
2187         site_map_list_title ($F, "$short");
2188         site_map_long_title ($F, "generated sitemap index");
2189         site_map_list_date  ($F, &timetoday());
2190     }
2191 }
2192
2193 sub scan_htmlfile # "$F"
2194 {
2195     my ($FF,$Z) = @_;
2196     $SOURCEFILE=&html_sourcefile($F);                                  # SCAN :
2197     hint "'$SOURCEFILE': scanning -> $F";                              # HTML :
2198     if ($SOURCEFILE ne $F) {
2199     if ( -f $SOURCEFILE) {
2200         dx_init "$F";
2201         dx_text ("today", &timetoday());
2202         dx_text ("todays", &timetodays());
2203         DC_VARS_Of ($SOURCEFILE); HTTP_VARS_Of ($SOURCEFILE);
2204         DC_title ($SOURCEFILE);
2205         DC_isFormatOf ($SOURCEFILE);
2206         DC_modified ($SOURCEFILE);
2207         DC_date ($SOURCEFILE); DC_date ($SITEFILE);
2208         DC_section ($F);  DC_selected ($F);  DX_alternative ($SOURCEFILE);
2209         if ($ENV{USER}) { DC_publisher ($ENV{USER}); }
2210         DX_text ("date.formatted", &timetoday());
2211         if ($printerfriendly) {
2212             DX_text ("printerfriendly", fast_html_printerfile($F)); }
2213         my $sectn=&info_get_entry("DC.relation.section");
2214         my $short=&info_get_entry("DC.title.selected");
2215         &site_map_list_title ($F, "$short");
2216         &info_map_list_title ($F, "$short");
2217         my $title=&info_get_entry("DC.title");
2218         &site_map_long_title ($F, "$title");
2219         &info_map_long_title ($F, "$title");
2220         my $edate=&info_get_entry("DC.date");
2221         my $issue=&info_get_entry("issue");
2222         &site_map_list_date ($F, "$edate");
2223         &info_map_list_date ($F, "$edate");
2224         css_scan();
2225         echo "'$SOURCEFILE':  '$title' ('$short') @ '$issue' ('$sectn')";
2226     }else {
2227         echo "'$SOURCEFILE': does not exist";
2228         site_map_list_title ($F, "$F");
2229         site_map_long_title ($F, "$F (no source)");
2230     }
2231     } else {
2232         echo "<$F> - skipped - ($SOURCEFILE)";
2233     }
2234 }
2235
2236 sub scan_subsitemap_long
2237 {
2238     my ($V,$W,$ZZZ) = @_;
2239     for (source($V)) {
2240         my $x = $_;
2241         if ($x =~ m|<a href="([^\"]*)">.*<small style="date">([^<>]*)</small>|) {
2242             &site_map_list_date($W.$1,$2);
2243         }
2244         if ($x =~ m|<a href="([^\"]*)">.*<!--long-->([^<>]*)<!--/long-->|) {
2245             &site_map_long_title($W.$1,$2);
2246         }
2247     }
2248 }
2249
2250 sub scan_namespec
2251 {
2252     # nothing so far
2253     # my ($F,$ZZZ) = @_;
2254     if ($F =~ /^name:sitemap:/) {
2255         my $short=$F;
2256         $short =~ s:.*/::; $short =~ s:[.].*::; # basename for all exts
2257         $short =~ s/name:sitemap://;
2258         $short .=" ~";
2259         site_map_list_title ($F, "$short");
2260         site_map_long_title ($F, "external sitemap index");
2261         site_map_list_date  ($F, &timetoday());
2262         echo "'$F' external sitemap index";
2263     }
2264     elsif ($F =~ /^name:(.*\.html*)$/) { # assuming it is a subsitefile
2265         my $FF=$1;
2266         my $FFF=$FF; $FFF =~ s:/[^/]*$:/:; # dirname
2267         $FFF="" if $FFF !~ m:/:;
2268         make_subsitemap_list($FF, $FFF);
2269         scan_subsitemap_long($FF, $FFF);
2270     }
2271 }
2272 sub scan_httpspec
2273 {
2274     # nothing so far
2275 }
2276
2277 sub skip_namespec
2278 {
2279     # nothing so far
2280 }
2281 sub skip_httpspec
2282 {
2283     # nothing so far
2284 }
2285
2286 # ==========================================================================
2287 # and now generate the output pages
2288 #                                                                   2.PASS
2289
2290 sub head_sed_sitemap # $filename $section
2291 {
2292     my ($U,$V,$Z) = @_;
2293     my $FF=&sed_piped_key($U);
2294     my $SECTION=&sed_slash_key($V);
2295     my $SECTS="sect=\"[$NN$AZ]\"" ;
2296     my $SECTN="sect=\"[$NN]\""; # lines with hrefs
2297     my @OUT = ();
2298     push @OUT, "s|(<a $SECTS href=\\\"$FF\\\">.*</a>)|<b>\$1</b>|;";
2299     push @OUT, "/ href=\\\"$SECTION\\\"/ "
2300         ."and s|^<td class=\\\"[^\\\"]*\\\"|<td |;" if $sectiontab ne "no";
2301     return @OUT;
2302 }
2303
2304 sub head_sed_listsection # $filename $section
2305 {
2306    # traditional.... the sitefile is the full navigation bar
2307     my ($U,$V,$Z) = @_;
2308     my $FF=&sed_piped_key($U);
2309     my $SECTION=&sed_slash_key($V);
2310     my $SECTS="sect=\"[$NN$AZ]\"" ;
2311     my $SECTN="sect=\"[$NN]\""; # lines with hrefs
2312     my @OUT = ();
2313     push @OUT, "s|(<a $SECTS href=\\\"$FF\\\">.*</a>)|<b>\$1</b>|;";
2314     push @OUT, "/ href=\\\"$SECTION\\\"/ "
2315         ."and s|^<td class=\\\"[^\\\"]*\\\"|<td |;" if $sectiontab ne "no";
2316     return @OUT;
2317 }
2318
2319 sub head_sed_multisection # $filename $section
2320 {
2321     # sitefile navigation bar is split into sections
2322     my ($U,$V,$Z) = @_;
2323     my $FF=&sed_piped_key($U);
2324     my $SECTION=&sed_slash_key($V);
2325     my $SECTS="sect=\"[$NN$AZ]\"" ;
2326     my $SECTN="sect=\"[$NN]\""; # lines with hrefs
2327     my @OUT = ();
2328     # grep all pages with a =sect= relation to current $SECTION and
2329     # build foreach an sed line "s|<a $SECTS (href=$F)>|<a sect="X" $1>|"
2330     # after that all the (still) numeric SECTNs are deactivated / killed.
2331     for my $section ($SECTION, $headsection, $tailsection) {
2332         next if $section eq "no";
2333         for (grep {/^<$Q='sect'>[^ ]* $section/} @MK_DATA) {
2334             my $x = $_;
2335             $x =~ s|<$Q='sect'>||; $x =~ s| .*||; # $filename
2336             $x =~ s/(.*)/s|<a $SECTS \(href=\\\"$1\\\"\)|<a sect=\\\"X\\\" \$1|/;
2337             push @OUT, $x.";";
2338         }
2339         for (grep {/^<$Q='sect'>name:[^ ]* $section/} @MK_DATA) {
2340             my $x = $_;
2341             $x =~ s|<$Q='sect'>name:||; $x =~ s| .*||; # $filename
2342             $x =~ s/(.*)/s|<a $SECTS \(name=\\\"$1\\\"\)|<a sect=\\\"X\\\" \$1|/;
2343             push @OUT, $x.";";
2344         }
2345     }
2346     push @OUT, "s|.*<a ($SECTN href=[^<>]*)>.*|<!-- \$1 -->|;";
2347     push @OUT, "s|.*<a ($SECTN name=[^<>]*)>.*|<!-- \$1 -->|;";
2348     push @OUT, "s|(<a $SECTS href=\\\"$FF\\\">.*</a>)|<b>\$1</b>|;";
2349     push @OUT, "/ href=\\\"$SECTION\\\"/ "
2350         ."and s|^<td class=\\\"[^\\\"]*\\\"|<td |;" if $sectiontab ne "no";
2351     return @OUT;
2352 }
2353
2354 sub make_sitefile # "$F"
2355 {
2356     $SOURCEFILE=&html_sourcefile($F);
2357  if ($SOURCEFILE ne $F) {
2358  if (-f $SOURCEFILE) {
2359    # remember that in this case "${SITEFILE}l" = "$F" = "${SOURCEFILE}l"
2360    @MK_VARS = &info2vars_sed();           # have <!--title--> vars substituted
2361    @MK_META = &info2meta_sed();           # add <meta name="DC.title"> values
2362    my @F_HEAD = (); my @F_FOOT = ();
2363    push @F_HEAD, @MK_PUTS;
2364    push @F_HEAD, &head_sed_sitemap ($F, &info_get_entry_section());
2365    push @F_HEAD, "/<head>/ and $sed_add join(\"\\n\", \@MK_META);";
2366    push @F_HEAD, @MK_VARS; push @F_HEAD, @MK_TAGS;
2367    push @F_HEAD, "/<\\/body>/ and next;";                #cut lastline
2368    if ( $sitemaplayout eq "multi") {
2369        push @F_FOOT,  &make_multisitemap();        # here we use ~foot~ to
2370    } else {
2371        push @F_FOOT,  &make_listsitemap();         # hold the main text
2372    }
2373
2374    my $html = ""; #
2375    $html .= &eval_MK_FILE("SITE", $SITEFILE, @F_HEAD);
2376    $html .= join("", @F_FOOT);
2377    for (source($SITEFILE)) {
2378        /<\/body>/ or next;
2379        $html .= &eval_MK_LIST("sitefile", $_, @MK_VARS);
2380    }
2381   open F, ">$F"; print F $html; close F;
2382   echo "'$SOURCEFILE': ",ls_s($SOURCEFILE)," >-> ",ls_s($F);
2383    savesource("$F.~head~", \@F_HEAD);
2384    savesource("$F.~foot~", \@F_FOOT);
2385 } else {
2386     echo "'$SOURCEFILE': does not exist";
2387 } }
2388 }
2389
2390 sub make_htmlfile # "$F"
2391 {
2392     $SOURCEFILE=&html_sourcefile($F);                      #     2.PASS
2393  if ("$SOURCEFILE" ne "$F") {
2394  if (-f "$SOURCEFILE") {
2395     if (grep {/<meta name="formatter"/} source($SOURCEFILE)) {
2396       echo "'$SOURCEFILE': SKIP, this sourcefile looks like a formatted file";
2397       echo "'$SOURCEFILE':  (may be a sourcefile in place of a targetfile?)";
2398     return; }
2399     @MK_VARS = &info2vars_sed();           # have <!--title--> vars substituted
2400     @MK_META = &info2meta_sed();           # add <meta name="DC.title"> values
2401     @MK_SPAN = &tags2span_sed();       # extern text/css -> intern css classes
2402     push @MK_META, &tags2meta_sed();       # extern text/css -> intern css classes
2403     my @F_HEAD = (); my @F_BODY = (); my $F_FOOT = "";
2404     push @F_HEAD, @MK_PUTS;
2405     if ( $sectionlayout eq "multi") {
2406         push @F_HEAD, &head_sed_multisection ($F, &info_get_entry_section());
2407     } else {
2408         push @F_HEAD, &head_sed_listsection ($F, &info_get_entry_section());
2409     }
2410     push @F_HEAD, @MK_VARS; push @F_HEAD, @MK_TAGS; push @F_HEAD, @MK_SPAN;
2411     push @F_HEAD, "/<\\/body>/ and next;";                #cut lastline
2412     push @F_HEAD, "/<head>/ and $sed_add join(\"\\n\",\@MK_META);"; #add metatags
2413     push @F_BODY, "/<title>/ and next;";                  #not that line
2414     push @F_BODY, @MK_VARS; push @F_BODY, @MK_TAGS; push @F_BODY, @MK_SPAN;
2415     push @F_BODY, &bodymaker_for_sectioninfo();             #if sectioninfo
2416     push @F_BODY, &info2body_sed();                         #cut early
2417     push @F_HEAD, &info2head_sed();
2418     push @F_HEAD, &make_back_path($F);
2419     if ($emailfooter ne "no") {
2420         $F_FOOT = &body_for_emailfooter();
2421     }
2422     my $html = "";
2423     $html .= eval_MK_FILE("head", $SITEFILE, @F_HEAD);
2424     $html .= eval_MK_FILE("body", $SOURCEFILE, @F_BODY);
2425     $html .= $F_FOOT;
2426     for (source($SITEFILE)) {
2427         /<\/body>/ or next;
2428         $_ = &eval_MK_LIST("htmlfile", $_, @MK_VARS);
2429         $html .= $_;
2430     }
2431     open F, ">$F" or die "could not write $F: $!"; print F $html; close F;
2432     echo "'$SOURCEFILE': ",&ls_s($SOURCEFILE)," -> ",&ls_s($F);
2433     savesource("$F.~head~", \@F_HEAD);
2434     savesource("$F.~body~", \@F_BODY);
2435  } else {
2436      echo "'$SOURCEFILE': does not exist";
2437  }} else {
2438      echo "<$F> - skipped";
2439  }
2440 }
2441
2442 my $PRINTSITEFILE;
2443 sub make_printerfriendly # "$F"
2444 {                                                                 # PRINTER
2445     my $printsitefile="0";                                        # FRIENDLY
2446     my $BODY_TXT; my $BODY_SED;
2447     my $P=&html_printerfile ($F);
2448     my @P_HEAD = (); my @P_BODY = ();
2449     if ("$F" =~ /^(${SITEFILE}|${SITEFILE}l)$/) {
2450         $printsitefile=">=>" ; $BODY_TXT="$F.~foot~" ;
2451     } elsif ("$F" =~ /^(.*[.]html)$/) {
2452         $printsitefile="=>" ;  $BODY_TXT="$SOURCEFILE";
2453     }
2454     if (grep {/<meta name="formatter"/} source($BODY_TXT)) { return; }
2455     if ($printsitefile ne "0" and -f $SOURCEFILE) {       my $x;
2456       @MK_FAST = &make_printerfile_fast (\@FILELIST);
2457       push @P_HEAD, @MK_VARS; push @P_HEAD, @MK_TAGS; push @P_HEAD, @MK_FAST;
2458       @MK_METT = map { $x = $_; $x =~
2459       /DC.relation.isFormatOf/ and $x =~ s|content=\"[^\"]*\"|content=\"$F\"| ;
2460           $x } @MK_META;
2461       push @P_HEAD, "/<head>/ and $sed_add join(\"\\n\", \@MK_METT);";
2462       push @P_HEAD, "/<\\/body>/ and next;";
2463       push @P_HEAD, &select_in_printsitefile ("$F");
2464       my $_ext_=&print_extension($printerfriendly);
2465 #     my $line_=&sed_slash_key($printsitefile_img_2);
2466       push @P_HEAD, "/\\|\\|topics:/"
2467           ." and s| href=\\\"\\#\\.\\\"| href=\\\"$F\\\"|;";
2468       push @P_HEAD, "/\\|\\|\\|pages:/"
2469           ." and s| href=\\\"\\#\\.\\\"| href=\\\"$F\\\"|;";
2470       push @P_HEAD, &make_back_path("$F");
2471       push @P_BODY, @MK_VARS; push @P_BODY, @MK_TAGS; push @P_BODY, @MK_FAST;
2472       push @P_BODY, &make_back_path("$F");
2473       my $html = "";
2474       $html .= eval_MK_FILE("p_head", $PRINTSITEFILE, @P_HEAD);
2475       $html .= eval_MK_FILE("p_body", $BODY_TXT, @P_BODY);
2476       for (source($PRINTSITEFILE)) {
2477           /<\/body>/ or next;
2478           $_ = &eval_MK_LIST("printerfriendly", $_, @MK_VARS);
2479           $html .= $_;
2480       }
2481       open P, ">$P" or die "could not write $P: $!"; print P $html; close P;
2482       echo "'$SOURCEFILE': ",ls_s($SOURCEFILE)," $printsitefile ",ls_s($P);
2483   }
2484 }
2485
2486
2487 # ========================================================================
2488 # ========================================================================
2489 # ========================================================================
2490 # ========================================================================
2491 #                                                          #### 0. INIT
2492 $F=$SITEFILE;
2493 &make_sitemap_init();
2494 &make_sitemap_list($SITEFILE);
2495 &make_sitemap_sect();
2496 &make_sitemap_page();
2497 savelist(\@MK_DATA, "DATA");
2498
2499 @FILELIST=&echo_site_filelist();
2500 if ($o{filelist} or $o{list} eq "file" or $o{list} eq "files") {
2501     for (@FILELIST) { echo $_;  } exit; # --filelist
2502 }
2503 if ($o{files}) { @FILELIST=split(/ /, $o{files}); } # --files
2504 if ($#FILELIST < 0) { warns "nothing to do (no --filelist)"; }
2505 if ($#FILELIST == 0 and
2506     $FILELIST[0] eq $SITEFILE) { warns "only '$SITEFILE'?!"; }
2507
2508 for (@FILELIST) {                                    #### 1. PASS
2509     $F = $_;
2510     if (/^(name:.*)$/) {
2511         &scan_namespec ("$F");
2512     } elsif (/^(http:|https:|ftp:|mailto:|telnet:|news:|gopher:|wais:)/) {
2513         &scan_httpspec ("$F");
2514     } elsif (/^(${SITEFILE}|${SITEFILE}l)$/) {
2515         &scan_sitefile ("$F") ;;                      # ........... SCAN SITE
2516     } elsif (/^(.*\@.*\.de)$/) {
2517         echo "!! -> '$F' (skipping malformed mailto:-link)";
2518     } elsif (/^(\.\.\/.*)$/) {
2519         echo "!! -> '$F' (skipping topdir build)";
2520 # */*.html)
2521 #    make_back_path  # try for later subdir build
2522 #    echo "!! -> '$F' (skipping subdir build)"
2523 #    ;;
2524 # */*/*/|*/*/|*/|*/index.htm|*/index.html)
2525 #    echo "!! -> '$F' (skipping subdir index.html)"
2526 #    ;;
2527     } elsif (/^(.*\.html)$/) {
2528         &scan_htmlfile ("$F");                        # ........... SCAN HTML
2529         if ($o{xml}) {
2530             $F =~ s/\.html$/.xml/;
2531             &scan_xmlfile ("$F");
2532         }
2533     } elsif (/^(.*\.xml)$/) {
2534         &scan_xmlfile ("$F") ;;
2535     } elsif (/^(.*\/)$/) {
2536         echo "'$F' : directory - skipped";
2537         &site_map_list_title ("$F", &sed_slash_key($F));
2538         &site_map_long_title ("$F", "(directory)");
2539     } else {
2540         echo "?? -> '$F'";
2541     }
2542 }
2543
2544 if ($printerfriendly) {                            # .......... PRINT VERSION
2545     my $_ext_=esc(&print_extension($printerfriendly));
2546     $PRINTSITEFILE=$SITEFILE; $PRINTSITEFILE =~ s/(\.\w*)$/$_ext_$1/;
2547     $F=$PRINTSITEFILE;
2548     my @TEXT = &make_printsitefile();
2549     echo "NOTE: going to create printer-friendly sitefile '$PRINTSITEFILE'"
2550         ." $F._$i";
2551     savelist(\@TEXT, "TEXT");
2552     my @LINES = map { chomp; $_."$n" } @TEXT;
2553     savesource($PRINTSITEFILE, \@LINES);
2554     if (1) {
2555         if (open PRINTSITEFILE, ">$PRINTSITEFILE") {
2556             print PRINTSITEFILE join("", @LINES); close PRINTSITEFILE;
2557         }
2558     }
2559 }
2560
2561 for (@FILELIST) {                                          #### 2. PASS
2562   $F = $_;
2563   if (/^(name:.*)$/) {
2564       &skip_namespec ("$F") ;;
2565   } elsif (/^(http:|https:|ftp:|mailto:|telnet:|news:|gopher:|wais:)/) {
2566       &skip_httpspec ("$F") ;;
2567   } elsif (/^(${SITEFILE}|${SITEFILE}l)$/) {
2568       &make_sitefile ("$F") ;;                         # ........ SITE FILE
2569       &make_printerfriendly ("$F") if ($printerfriendly);
2570       if ($o{xml}) {
2571           $F =~ s/\.html$/.xml/;
2572           &make_xmlmaster ("$F");
2573       }
2574   } elsif (/^(.*\@.*\.de)$/) {
2575       echo "!! -> '$F' (skipping malformed mailto:-link)";
2576   } elsif (/^(\.\.\/.*)$/) {
2577       echo "!! -> '$F' (skipping topdir build)";
2578 # */*.html)
2579 #   echo "!! -> '$F' (skipping subdir build)"
2580 #   ;;
2581 # */*/*/|*/*/|*/|*/index.htm|*/index.html)
2582 #   echo "!! -> '$F' (skipping subdir index.html)"
2583 #   ;;
2584   } elsif (/^(.*\.html)$/) {
2585       &make_htmlfile ("$F") ;                # .................. HTML FILES
2586       &make_printerfriendly ("$F") if ($printerfriendly);
2587       if ($o{xml}) {
2588           $F =~ s/\.html$/.xml/;
2589           &make_xmlfile ("$F");
2590       }
2591   } elsif (/^(.*\.xml)$/) {
2592       &make_xmlfile ("$F") ;;
2593   } elsif (/^(.*\/)$/) {
2594       echo "'$F' : directory - skipped";
2595   } else {
2596       echo "?? -> '$F'";
2597   }
2598
2599 # .............. debug ....................
2600   if (-d "DEBUG" and -f $F)  {
2601       my $INP = \@{$DATA{$F}};
2602       my $FFFF = $F; $FFFF =~ s,/,:,g;
2603       if (open FFFF, ">DEBUG/$FFFF.data.tmp.ht") {
2604           for (@{$INP}) { print FFFF $_,$n; } close FFFF;
2605       }
2606       if (open FFFF, ">DEBUG/$FFFF.tags.tmp.pl") {
2607           print FFFF "# /usr/bin/env perl -p",$n;
2608           for (@MK_TAGS) { print FFFF $_,$n; } close FFFF;
2609       }
2610       if (open FFFF, ">DEBUG/$FFFF.vars.tmp.pl") {
2611           print FFFF "# /usr/bin/env perl -p",$n;
2612           for (@MK_VARS) { print FFFF $_,$n; } close FFFF;
2613       }
2614       if (open FFFF, ">DEBUG/$FFFF.span.tmp.pl") {
2615           print FFFF "# /usr/bin/env perl -p",$n;
2616           for (@MK_SPAN) { print FFFF $_,$n; } close FFFF;
2617       }
2618       if (open FFFF, ">DEBUG/$FFFF.meta.tmp.ht") {
2619           for (@MK_META) { print FFFF $_,$n; } close FFFF;
2620       }
2621       if (open FFFF, ">DEBUG/$FFFF.gets.tmp.ht") {
2622           for (@MK_GETS) { print FFFF $_,$n; } close FFFF;
2623       }
2624       if (open FFFF, ">DEBUG/$FFFF.puts.tmp.ht") {
2625           for (@MK_PUTS) { print FFFF $_,$n; } close FFFF;
2626       }
2627       if (open FFFF, ">DEBUG/$FFFF.fast.tmp.ht") {
2628           for (@MK_FAST) { print FFFF $_,$n; } close FFFF;
2629       }
2630   }
2631 } # done
2632
2633 ## rm ./$MK.*.tmp.* if not $o{keeptmpfiles}
2634 exit 0