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 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 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.1 2005-12-13 00:27:06 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 $INFO="~~";     # 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
  55 # LANG="C" ; LANGUAGE="C" ; LC_COLLATE="C"     # these are needed for proper
  56 # export LANG LANGUAGE LC_COLLATE              # lowercasing as some collate
  57                                                # treat A-Z to include a-z
  58
  59 # ==========================================================================
  60 # reading options from the command line                            GETOPT
  61 my %o = (); # to store option variables
  62 $o{variables}="files";
  63 $o{fileseparator}="?";
  64 $o{files}="";
  65 $o{main_file}="";
  66 $o{formatter}="$0";
  67 my $opt="";
  68 for my $arg (@ARGV) {     # this variant should allow to embed spaces in $arg
  69     if ($opt) {
  70         $o{$opt}=$arg;
  71         $opt="";
  72     } else {
  73         $_=$arg;
  74         if (/^-.*=.*$/) {
  75             $opt=$arg; $opt =~ s/-*([$AA][$AA-]*).*/$1/; $opt =~ y/-/_/;
  76             if (not $opt) {
  77                 print STDERR "ERROR: invalid option $arg$n";
  78             } else {
  79                 $arg =~ s/^[^=]*=//;
  80                 $o{$opt} = $arg;
  81                 $o{variables} .= " ".$opt;
  82             }
  83             $opt="";;
  84         } elsif (/^-.*-.*$/) {
  85             $opt=$arg; $opt =~ s/-*([$AA][$AA-]*).*/$1/; $opt =~ y/-/_/;
  86             if (not $opt) {
  87                 print STDERR "ERROR: invalid option $arg$n";
  88                 $opt="";
  89             } else {
  90                     # keep the option for next round
  91             } ;;
  92         } elsif (/^-.*/) {
  93             $opt=$arg; $opt =~ s/^-*([$AA][$AA-]*).*/$1/; $opt =~ y/-/_/;
  94             if (not $opt) {
  95                 print STDERR "ERROR: invalid option $arg$n";
  96             } else {
  97                 $arg =~ s/^[^=]*=//;
  98                 $o{$opt} = ' ';
  99             }
 100             $opt="" ;;
 101         } else {
 102             if (not $o{main_file}) { $o{main_file} = $arg; } else {
 103             $o{files} .= $o{fileseparator} if $o{files};
 104             $o{files} .= $arg; };
 105             $opt="" ;;
 106         };
 107     }
 108 } ; if ($opt) {
 109         $o{$opt}=" ";
 110         $opt="";
 111     }
 112
 113 ### env | grep ^opt
 114
 115 $SITEFILE=$o{main_file} if $o{main_file} and -f $o{main_file};
 116 $SITEFILE=$o{site_file} if $o{site_file} and -f $o{site_file};
 117
 118 if ($o{help}) {
 119     $_=$SITEFILE;
 120     print "$0 [sitefile]$n";
 121     print "  default sitefile = $_$n";
 122     print "options:$n"
 123         . " --filelist : show list of target files as ectracted from $_$n"
 124         . " --src xx : if source files are not where mksite is executed$n";
 125     exit;
 126     print " internal:$n"
 127         ."--fileseparator=x : for building the internal filelist (def. '?')$n"
 128         ."--files xx : for list of additional files to be processed$n"
 129         ."--main-file xx : for the main sitefile to take file list from$n";
 130 }
 131
 132 if (not $SITEFILE) {
 133     print STDERR "error: no SITEFILE found (default would be 'site.htm')$n";
 134     exit 1;
 135 } else {
 136     print STDERR "NOTE: sitefile: ",`ls -s $SITEFILE`,"$n";
 137 }
 138
 139 # we use internal hashes to store mappings - kind of relational tables
 140 my @MK_TAGS= (); # "./$MK.tags.tmp"
 141 my @MK_VARS= (); # "./$MK.vars.tmp"
 142 my @MK_META= (); # "./$MK.meta.tmp"
 143 my @MK_METT= (); # "./$MK.mett.tmp"
 144 my @MK_TEST= (); # "./$MK.test.tmp"
 145 my @MK_FAST= (); # "./$MK.fast.tmp"
 146 my @MK_GETS= (); # "./$MK.gets.tmp"
 147 my @MK_PUTS= (); # "./$MK.puts.tmp"
 148 my @MK_OLDS= (); # "./$MK.olds.tmp"
 149 my @MK_SITE= (); # "./$MK.site.tmp"
 150 my @MK_SECT1= (); # "./$MK.sect1.tmp"
 151 my @MK_SECT2= (); # "./$MK.sect2.tmp"
 152 my @MK_SECT3= (); # "./$MK.sect3.tmp"
 153 my @MK_INFO= (); # "./$MK~~"
 154 my %INFO= (); # used for $F.$PARTs
 155 my %FAST= ();
 156
 157 # ========================================================================
 158 # ========================================================================
 159 # ========================================================================
 160 #                                                             MAGIC VARS
 161 #                                                            IN $SITEFILE
 162 my $printerfriendly="";
 163 my $sectionlayout="list";
 164 my $sitemaplayout="list";
 165 my $simplevars="warn";      # <!--varname-->default
 166 my $attribvars=" ";         # <x ref="${varname:=default}">
 167 my $updatevars=" ";         # <!--$varname:=-->default
 168 my $expandvars=" ";         # <!--$varname-->
 169 my $commentvars=" ";        # $updatevars && $expandsvars && $simplevars
 170 my $sectiontab=" ";         # highlight ^<td class=...>...href="$section"
 171 my $currenttab=" ";         # highlight ^<br>..<a href="$topic">
 172 my $headsection="no";
 173 my $tailsection="no";
 174 my $sectioninfo="no";       # using <h2> title <h2> = info text
 175 my $emailfooter="no";
 176
 177 for (source($SITEFILE)) {
 178     if (/<!--multi-->/) {
 179         warn("WARNING: do not use <!--multi-->,"
 180              ." change to <!--mksite:multi-->  $SITEFILE"
 181              ."warning: or"
 182              ." <!--mksite:multisectionlayout-->"
 183              ." <!--mksite:multisitemaplayout-->");
 184         $sectionlayout="multi";
 185         $sitemaplayout="multi";
 186     }
 187     if (/<!--mksite:multi-->/) {
 188         $sectionlayout="multi";
 189         $sitemaplayout="multi";
 190     }
 191     if (/<!--mksite:multilayout-->/) {
 192         $sectionlayout="multi";
 193         $sitemaplayout="multi";
 194     }
 195 }
 196
 197 sub mksite_magic_option
 198 {
 199     # $1 is word/option to check for
 200     my ($U,$INP,$Z) = @_;
 201     $INP=$SITEFILE if not $INP;
 202     for (source($INP)) {
 203         s/(<!--mksite:)($U)-->/$1$2: -->/g;
 204         s/(<!--mksite:)(\w\w*)($U)-->/$1$3:$2-->/g;
 205         /<!--mksite:$U:/ or next;
 206         s/.*<!--mksite:$U:([^<>]*)-->.*/$1/;
 207         s/.*<!--mksite:$U:([^-]*)-->.*/$1/;
 208         /<!--mksite:$U:/ and next;
 209         chomp;
 210         return $_;
 211     }
 212     return "";
 213 }
 214
 215 {
 216     my $x;
 217     $x=mksite_magic_option("sectionlayout"); if
 218         ($x =~ /^(list|multi)$/) { $sectionlayout="$x" ; }
 219     $x=mksite_magic_option("sitemaplayout"); if
 220         ($x =~ /^(list|multi)$/) { $sitemaplayout="$x" ; }
 221     $x=mksite_magic_option("simplevars"); if
 222         ($x =~ /^( |no|warn)$/) { $simplevars="$x" ; }
 223     $x=mksite_magic_option("attribvars"); if
 224         ($x =~ /^( |no|warn)$/) { $attribvars="$x" ; }
 225     $x=mksite_magic_option("updatevars"); if
 226         ($x =~ /^( |no|warn)$/) { $updatevars="$x" ; }
 227     $x=mksite_magic_option("expandvars"); if
 228         ($x =~ /^( |no|warn)$/) { $expandvars="$x" ; }
 229     $x=mksite_magic_option("commentvars"); if
 230         ($x =~ /^( |no|warn)$/) { $commentvars="$x" ; }
 231     $x=mksite_magic_option("printerfriendly"); if
 232         ($x =~ /^( |[.].*|[-]-.*)$/) { $printerfriendly="$x" ; }
 233     $x=mksite_magic_option("sectiontab"); if
 234         ($x =~ /^( |no|warn)$/) { $sectiontab="$x" ; }
 235     $x=mksite_magic_option("currenttab"); if
 236         ($x =~ /^( |no|warn)$/) { $currenttab="$x" ; }
 237     $x=mksite_magic_option("sectioninfo"); if
 238         ($x =~ /^( |no|[=:-])$/) { $sectioninfo="$x" ; }
 239     $x=mksite_magic_option("commentvars"); if
 240         ($x =~ /^( |no|warn)$/) { $commentvars="$x" ; }
 241     $x=mksite_magic_option("emailfooter"); if
 242         ($x) { $emailfooter="$x"; }
 243 }
 244
 245 $printerfriendly=$o{print} if $o{print};
 246 $updatevars="no" if $commentvars eq "no"; # duplicated into
 247 $expandvars="no" if $commentvars eq "no"; # info2vars_sed
 248 $simplevars="no" if $commentvars eq "no"; # function above
 249
 250 print "NOTE: '$sectionlayout\'sectionlayout '$sitemaplayout\'sitemaplayout$n"
 251     if -d "DEBUG";
 252 print "NOTE: '$simplevars\'simplevars '$printerfriendly\'printerfriendly$n"
 253     if -d "DEBUG";
 254 print "NOTE: '$attribvars\'attribvars '$updatevars\'updatevars$n"
 255     if -d "DEBUG";
 256 print "NOTE: '$expandvars\'expandvars '$commentvars\'commentvars $n"
 257     if -d "DEBUG";
 258 print "NOTE: '$currenttab\'currenttab '$sectiontab\'sectiontab$n"
 259     if -d "DEBUG";
 260 print "NOTE: '$headsection\'headsection '$tailsection\'tailsection$n"
 261     if -d "DEBUG";
 262
 263 # ==========================================================================
 264 # init a few global variables
 265 #                                                                  0. INIT
 266
 267 # $MK.tags.tmp - originally, we would use a lambda execution on each
 268 # uppercased html tag to replace <P> with <p class="P">. Here we just
 269 # walk over all the known html tags and make an sed script that does
 270 # the very same conversion. There would be a chance to convert a single
 271 # tag via "h;y;x" or something we do want to convert all the tags on
 272 # a single line of course.
 273 @MK_TAGS=();
 274 for my $P (qw/P H1 H2 H3 H4 H5 H6 DL DD DT UL OL LI PRE CODE TABLE TR TD TH
 275            B U I S Q EM STRONG STRIKE CITE BIG SMALL SUP SUB TT THEAD TBODY
 276            CENTER HR BR NOBR WBR SPAN DIV IMG ADRESS BLOCKQUOTE/) {
 277     my $M=lc($P);
 278     push @MK_TAGS, "s|<$P>|<$M class=\\\"$P\\\">|g;";
 279     push @MK_TAGS, "s|<$P |<$M class=\\\"$P\\\" |g;";
 280     push @MK_TAGS, "s|</$P>|</$M>|g;";
 281 }
 282 push @MK_TAGS, "s|<>|\\&nbsp\\;|g;";
 283 push @MK_TAGS, "s|<->|<WBR />\\;|g;";
 284 # also make sure that some non-html entries are cleaned away that
 285 # we are generally using to inject meta information. We want to see
 286 # that meta ino in the *.htm browser view during editing but they
 287 # shall not get present in the final html page for publishing.
 288 my @DC_VARS =
 289     ("contributor", "date", "source", "language", "coverage", "identifier",
 290      "rights", "relation", "creator", "subject", "description",
 291      "publisher", "DCMIType");
 292 my @_EQUIVS =
 293     ("refresh", "expires", "content-type", "cache-control",
 294      "redirect", "charset", # mapped to refresh / content-type
 295      "content-language", "content-script-type", "content-style-type");
 296 for my $P (@DC_VARS) { # dublin core embedded
 297     push @MK_TAGS, "s|<$P>[^<>]*</$P>||g;";
 298 }
 299 for my $P (@_EQUIVS) {
 300     push @MK_TAGS, "s|<$P>[^<>]*</$P>||g;";
 301 }
 302 push @MK_TAGS, "s|<!--sect[$AZ$NN]-->||g;";
 303 push @MK_TAGS, "s|<!--[$AX]*[?]-->||g;";
 304 push @MK_TAGS, "s|<!--\\\$[$AX]*[?]:-->||g;";
 305 push @MK_TAGS, "s|<!--\\\$[$AX]*:[?=]-->||g;";
 306 push @MK_TAGS, "s|(<[^<>]*)\\\${[$AX]*:[?=]([^<{}>]*)}([^<>]*>)|\$1\$2\$3|g;";
 307
 308 my $TRIMM=" -e 's:^ *::' -e 's: *\$::'";  # trimm away leading/trailing spaces
 309 sub trimm
 310 {
 311     my ($T,$Z) = @_;
 312     $T =~ s:\A\s*::s; $T =~ s:\s*\Z::s;
 313     return $T;
 314 }
 315 sub trimmm
 316 {
 317     my ($T,$Z) = @_;
 318     $T =~ s:\A\s*::s; $T =~ s:\s*\Z::s; $T =~ s:\s+: :g;
 319     return $T;
 320 }
 321 sub timezone
 322 {
 323     # +%z is an extension while +%Z is supposed to be posix
 324     my $tz;
 325     eval { $tz = strftime("%z", localtime()) };
 326     return $tz  if $tz =~ /[+]/;
 327     return $tz  if $tz =~ /[-]/;
 328     return strftime("%Z", localtime());
 329 }
 330
 331 sub timetoday
 332 {
 333     return strftime("%Y-%m-%d", localtime());
 334 }
 335 sub timetodays
 336 {
 337     return strftime("%Y-%m%d", localtime());
 338 }
 339
 340 sub esc
 341 {
 342     my ($TXT,$XXX) = @_;
 343     $TXT =~ s|&|\\\\&|g;
 344     return $TXT;
 345 }
 346
 347 my %SOURCE;
 348 sub source # $file : @lines
 349 {
 350     my ($FILE,$Z) = @_;
 351     if (exists $SOURCE{$FILE}) { return @{$SOURCE{$FILE}}; }
 352     my @TEXT = ();
 353     open FILE, "<$FILE" or die "could not open $FILE: $!";
 354     for my $line (<FILE>) {
 355         push @TEXT, $line;
 356     } close FILE;
 357     @{$SOURCE{$FILE}} = @TEXT;
 358     return @{$SOURCE{$FILE}};
 359 }
 360 sub savesource # $file \@lines
 361 {
 362     my ($FILE,$LINES,$Z) = @_;
 363     @{$SOURCE{$FILE}} = @{$LINES};
 364 }
 365
 366 my $F; # current file during loop <<<<<<<<<
 367 my $i = 100;
 368 sub savelist {
 369     if (-d "DEBUG") {
 370         my $X = "$F._$i"; $i++; $X =~ s|/|:|g;
 371         open X, ">DEBUG/$X" or die "could not open $X: $!";
 372         print X "#! /usr/bin/perl -".$#_."$n";
 373         print X join("$n", @{$_[0]}),$n; close X;
 374     }
 375 }
 376
 377 sub eval_MK_LIST # $str @list
 378 {
 379     my $result = $_[0]; shift @_;
 380     my $extra = "";
 381     my $script = "\$_ = \$result; my \$Z;";
 382     $script .= join(";$n ", @_);
 383     $script .= "$n;\$result = \$_;$n";
 384     eval $script;
 385     return $result.$extra;
 386 }
 387
 388 sub eval_MK_FILE  {
 389     my $FILENAME = $_[0]; shift @_;
 390     my $result = "";
 391     my $script = "my \$FILE; my \$extra = ''; my \$Z; $n";
 392     $script.= "for (source('$FILENAME')) { $n";
 393     $script.= join(";$n  ", @_);
 394     $script.= "$n; \$result .= \$_; ";
 395     $script.= "$n if(\$extra){\$result.=\$extra;\$extra='';\$result.=\"\\n\"}";
 396     $script.= "$n} if(\$extra){\$result.=\$extra;}$n";
 397     savelist([$script,""]);
 398     eval $script;
 399     return $result;
 400 }
 401 my $sed_add = "\$extra .= "; # "/r ";
 402
 403 sub foo { print "               '$F'$n"; }
 404 sub ls_s {
 405     my $result = `ls -s @_`;
 406     chomp($result);
 407     return $result;
 408 }
 409
 410 # ======================================================================
 411 #                                                                FUNCS
 412
 413 my $SOURCEFILE; # current file <<<<<<<<
 414 my @FILELIST; # <<<<<<<
 415
 416 sub sed_slash_key  # helper to escape chars special in /anchor/ regex
 417 {                     # currently escaping "/" "[" "]" "."
 418     my $R = $_[0]; $R =~ s|[\"./[-]|\\$&|g; $R =~ s|\]|\\\\$&|g;
 419     return $R;
 420 }
 421 sub sed_piped_key  # helper to escape chars special in s|anchor|| regex
 422 {                     # currently escaping "|" "[" "]" "."
 423     my $R = $_[0]; $R =~ s/[\".|[-]/\\$&/g; $R =~ s/\]/\\\\$&/g;
 424     return $R;
 425 }
 426
 427 sub back_path      # helper to get the series of "../" for a given path
 428 {
 429     my ($R,$Z) = @_; if ($R !~ /\//) { return ""; }
 430     $R =~ s|/[^/]*$|/|; $R =~ s|[^/]*/|../|g;
 431     return $R;
 432 }
 433
 434 sub dir_name
 435 {
 436     my $R = $_[0]; $R =~ s:/[^/][^/]*\$::;
 437     return $R;
 438 }
 439
 440 sub info2test_sed # \@ \@ # cut out all old-style <!--vars--> usages
 441 {
 442     my ($INP,$XXX) = @_;
 443     $INP = \@{$INFO{$F}} if not $INP;
 444     my @OUT = ();
 445     my $V8=" *([^ ][^ ]*) (.*)";
 446     my $V9=" *DC[.]([^ ][^ ]*) (.*)";
 447     my $q="\\\$";
 448     my ($_x_,$_y_,$_X_,$_Y_); my $W = "WARNING:";
 449     $_x_= sub {"$W: assumed simplevar <!--$1--> changed to <!--$q$1:=-->" };
 450     $_y_= sub {"$W: assumed simplevar <!--$1--> changed to <!--$q$1:?-->" };
 451     $_X_= sub {"$W: assumed tailvar <!--$q$1:--> changed to <!--$q$1:=-->" };
 452     $_Y_= sub {"$W: assumed tailvar <!--$q$1:--> changed to <!--$q$1:?-->" };
 453     push @OUT, "s/^/ /;";
 454     for (@$INP) {
 455     if (/^=....=formatter /) { next; };
 456     if (/=[Tt]ext=$V9%/){ push @OUT, esc("s|.*<!--($1)-->.*|".&$_x_."|;");}
 457     if (/=[Nn]ame=$V9%/){ push @OUT, esc("s|.*<!--($1)[?]-->.*|".&$_y_."|;");}
 458     if (/=[Tt]ext=$V8%/){ push @OUT, esc("s|.*<!--($1)-->.*|".&$_x_."|;");}
 459     if (/=[Nn]ame=$V8%/){ push @OUT, esc("s|.*<!--($1)[?]-->.*|".&$_y_."|;");}
 460     }
 461     for (@$INP) {
 462     if (/^=....=formatter /) { next; };
 463     if (/=[Tt]ext=$V9%/){ push @OUT, esc("s|.*<!--($1):-->.*|".&$_X_."|;");}
 464     if (/=[Nn]ame=$V9%/){ push @OUT, esc("s|.*<!--($1)[?]:-->.*|".&$_Y_."|;");}
 465     if (/=[Tt]ext=$V8%/){ push @OUT, esc("s|.*<!--($1):-->.*|".&$_X_."|;");}
 466     if (/=[Nn]ame=$V8%/){ push @OUT, esc("s|.*<!--($1)[?]:-->.*|".&$_Y_."|;");}
 467     }
 468     push @OUT, "/^WARNING:/ || next;";
 469     return @OUT;
 470 }
 471
 472 sub info2vars_sed      # generate <!--$vars--> substition sed addon script
 473 {
 474     my ($INP,$Z) = @_;
 475     $INP = \@{$INFO{$F}} if not $INP;
 476     my @OUT = ();
 477     my $V8=" *([^ ][^ ]*) +(.*)";
 478     my $V9=" *DC[.]([^ ][^ ]*) +(.*)";
 479     my $N8=" *([^ ][^ ]*) ([$NN].*)";
 480     my $N9=" *DC[.]([^ ][^ ]*) ([$NN].*)";
 481     my $V0="([<]*)\\\$";
 482     my $V1="([^<>]*)\\\$";
 483     my $V2="([^{<>}]*)";
 484     my $V3="([^<>]*)";
 485     my $SS="<"."<>".">"; # spacer so value="2004" dont make for s|\(...\)|\12004|
 486     $Z="\$Z=";
 487     $updatevars = "no" if $commentvars  eq "no";   # duplicated from
 488     $expandvars = "no" if $commentvars  eq "no";   # option handling
 489     $simplevars = "no" if $commentvars  eq "no";   # tests below
 490     my @_INP = (); for (@{$INP}) { my $x=$_; $x =~ s/'/\\'/; push @_INP, $x; }
 491     if ($expandvars ne "no") {
 492         for (@_INP) {
 493     if    (/^=....=formatter /) { next; }
 494     elsif (/^=name=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|- \$Z|;"}
 495     elsif (/^=Name=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|(\$Z)|;"}
 496     elsif (/^=name=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|- \$Z|;"}
 497     elsif (/^=Name=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?-->|(\$Z)|;"}
 498         }
 499     }
 500     if ($expandvars ne "no") {
 501         for (@_INP) {
 502     if    (/^=....=formatter /) { next; }
 503     elsif (/^=text=$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 504     elsif (/^=Text=$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 505     elsif (/^=name=$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 506     elsif (/^=Name=$V9/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 507     elsif (/^=text=$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 508     elsif (/^=Text=$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1-->|\$1$SS\$Z|;"}
 509     elsif (/^=name=$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 510     elsif (/^=Name=$V8/){push @OUT, "\$Z='$2';s|<!--$V1$1\\?-->|\$1$SS\$Z|;"}
 511         }
 512     }
 513     if ($simplevars ne "no" && $updatevars ne "no") {
 514         for (@_INP) { my $Q = "[$AX]*";
 515     if    (/^=....=formatter /) { next; }
 516     elsif (/^=text=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1:-->$Q|\$Z|;"}
 517     elsif (/^=Text=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1:-->$Q|\$Z|;"}
 518     elsif (/^=name=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?:-->$Q|- \$Z|;"}
 519     elsif (/^=Name=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?:-->$Q|(\$Z)|;"}
 520     elsif (/^=text=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1:-->$Q|\$Z|;"}
 521     elsif (/^=Text=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1:-->$Q|\$Z|;"}
 522     elsif (/^=name=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?:-->$Q|- \$Z|;"}
 523     elsif (/^=Name=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1\\?:-->$Q|(\$Z)|;"}
 524         }
 525     }
 526     if ($updatevars ne "no") {
 527         for (@_INP) {  my $Q = "[^<>]*";
 528     if    (/^=....=formatter /) { next; }
 529     elsif (/^=name=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$Q|- \$Z|;"}
 530     elsif (/^=Name=$V9/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$Q|(\$Z)|;"}
 531     elsif (/^=name=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$Q|- \$Z|;"}
 532     elsif (/^=Name=$V8/){push @OUT, "\$Z='$2';s|<!--$V0$1:\\?-->$Q|(\$Z)|;"}
 533         }
 534     }
 535     if ($updatevars ne "no") {
 536         for (@_INP) {  my $Q = "[^<>]*";
 537     if    (/^=....=formatter /) { next; }
 538     elsif (/^=text=$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$Q|\$1$SS\$Z|;"}
 539     elsif (/^=Text=$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$Q|\$1$SS\$Z|;"}
 540     elsif (/^=name=$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$Q|\$1$SS\$Z|;"}
 541     elsif (/^=Name=$V9/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$Q|\$1$SS\$Z|;"}
 542     elsif (/^=text=$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$Q|\$1$SS\$Z|;"}
 543     elsif (/^=Text=$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\=-->$Q|\$1$SS\$Z|;"}
 544     elsif (/^=name=$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$Q|\$1$SS\$Z|;"}
 545     elsif (/^=Name=$V8/){push @OUT,"\$Z='$2';s|<!--$V1$1:\\?-->$Q|\$1$SS\$Z|;"}
 546         }
 547     }
 548     if ($attribvars ne "no") {
 549         for (@_INP) {  my $Q = "[^<>]*";
 550     if    (/^=....=formatter /) { next; }
 551     elsif (/^=text=$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 552     elsif (/^=Text=$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 553     elsif (/^=name=$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 554     elsif (/^=Name=$V9/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 555     elsif (/^=text=$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 556     elsif (/^=Text=$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[=]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 557     elsif (/^=name=$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 558     elsif (/^=Name=$V8/){push @OUT,"\$Z='$2';s|<$V1\{$1:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 559         }
 560         for (split / /, $o{variables}) {
 561             {push @OUT,"\$Z='$o{$_}';s|<$V1\{$_:[?]$V2}$V3>|<\$1$SS\$Z\$3>|;"}
 562         }
 563     }
 564     if ($simplevars ne "no") {
 565         for (@_INP) {  my $Q = "[$AX]*";
 566     if    (/^=....=formatter /) { next; }
 567     elsif (/^=text=$V9/){push @OUT, "\$Z='$2';s|<!--$1-->$Q|\$Z|;"}
 568     elsif (/^=Text=$V9/){push @OUT, "\$Z='$2';s|<!--$1-->$Q|\$Z|;"}
 569     elsif (/^=name=$V9/){push @OUT, "\$Z='$2';s|<!--$1\\?-->$Q| - \$Z|;"}
 570     elsif (/^=Name=$V9/){push @OUT, "\$Z='$2';s|<!--$1\\?-->$Q| (\$Z)|;"}
 571     elsif (/^=text=$V8/){push @OUT, "\$Z='$2';s|<!--$1-->$Q|\$Z|;"}
 572     elsif (/^=Text=$V8/){push @OUT, "\$Z='$2';s|<!--$1-->$Q|\$Z|;"}
 573     elsif (/^=name=$V8/){push @OUT, "\$Z='$2';s|<!--$1\\?-->$Q| - \$Z|;"}
 574     elsif (/^=Name=$V8/){push @OUT, "\$Z='$2';s|<!--$1\\?-->$Q| (\$Z)|;"}
 575         }
 576     }
 577     # if value="2004" then generated sed might be "\\12004" which is bad
 578     # instead we generate an edited value of "\\1$SS$value" and cut out
 579     # the spacer now after expanding the variable values:
 580     push @OUT, "s|$SS||g;";
 581     return @OUT;
 582
 583 }
 584
 585 sub info2meta_sed     # generate <meta name..> text portion
 586 {
 587     my ($INP,$XXX) = @_;
 588     $INP = \@{$INFO{$F}} if not $INP;
 589     my @OUT = ();
 590     # http://www.metatab.de/meta_tags/DC_type.htm
 591     my $V6=" *HTTP[.]([^ ]+) (.*)";
 592     my $V7=" *DC[.]([^ ]+) (.*)";
 593     my $V8=" *([^ ]+) (.*)" ;
 594     sub __TYPE_SCHEME { "name=\"DC.type\" content=\"$2\" scheme=\"$1\"" };
 595     sub __DCMI { "name=\"$1\" content=\"$2\" scheme=\"DCMIType\"" };
 596     sub __NAME { "name=\"$1\" content=\"$2\"" };
 597     sub __NAME_TZ { "name=\"$1\" content=\"$2 ".&timezone()."\"" };
 598     sub __HTTP { "http-equiv=\"$1\" content=\"$2\"" };
 599     for (@$INP) {
 600         if (/=....=today /) { next; }
 601         if (/=meta=HTTP[.]/ && /=meta=$V6/) {
 602             push @OUT, " <meta ${\(__HTTP)} />" if $2; next; }
 603         if (/=meta=DC[.]DCMIType / && /=meta=$V7/) {
 604             push @OUT, " <meta ${\(__TYPE_SCHEME)} />" if $2; next; }
 605         if (/=meta=DC[.]type Collection$/ && /=meta=$V8/) {
 606             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 607         if (/=meta=DC[.]type Dataset$/ && /=meta=$V8/) {
 608             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 609         if (/=meta=DC[.]type Event$/ && /=meta=$V8/) {
 610             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 611         if (/=meta=DC[.]type Image$/ && /=meta=$V8/) {
 612             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 613         if (/=meta=DC[.]type Service$/ && /=meta=$V8/) {
 614             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 615         if (/=meta=DC[.]type Software$/ && /=meta=$V8/) {
 616             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 617         if (/=meta=DC[.]type Sound$/ && /=meta=$V8/) {
 618             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 619         if (/=meta=DC[.]type Text$/ && /=meta=$V8/) {
 620             push @OUT, " <meta ${\(__DCMI)} />" if $2; next; }
 621         if (/=meta=DC[.]date[.].*[+]/ && /=meta=$V8/) {
 622             push @OUT, " <meta ${\(__NAME)} />" if $2; next; }
 623         if (/=meta=DC[.]date[.].*[:]/ && /=meta=$V8/) {
 624             push @OUT, " <meta ${\(__NAME_TZ)} />" if $2; next; }
 625         if (/=meta=/ && /=meta=$V8/) {
 626             push @OUT, " <meta ${\(__NAME)} />" if $2; next; }
 627     }
 628     return @OUT;
 629 }
 630
 631 sub info_get_entry # get the first <!--vars--> value known so far
 632 {
 633     my ($TXT,$INP,$XXX) = @_;
 634     $TXT = "sect" if not $TXT;
 635     $INP = \@{$INFO{$F}} if not $INP;
 636     for (grep {/=text=$TXT /} @$INP) {
 637         my $info = $_;
 638         $info =~ s/=text=$TXT //;
 639         chomp($info); chomp($info); return $info;
 640     }
 641 }
 642
 643 sub info1grep # test for a <!--vars--> substition to be already present
 644 {
 645     my ($TXT,$INP,$XXX) = @_;
 646     $TXT = "sect" if not $TXT;
 647     $INP = \@{$INFO{$F}} if not $INP;
 648     return scalar(grep {/^=text=$TXT /} @$INP); # returning the count
 649 }
 650
 651 sub dx_init
 652 {
 653     @{$INFO{$F}} = ();
 654     &dx_meta ("formatter", basename($o{formatter}));
 655     for (split / /, $o{variables}) {        # commandline --def=value
 656         if (/_/) { my $u=$_; $u =~ y/_/-/;  # makes for <!--$def--> override
 657                    &dx_meta ($u, $o{$_});
 658         } else {   &dx_text ($_, $o{$_}); }
 659     }
 660 }
 661
 662 sub dx_line
 663 {
 664     my ($U,$V,$W,$Z) = @_; chomp($U); chomp($V);
 665     push @{$INFO{$F}}, $U.$V." ".trimmm($W);
 666 }
 667
 668 sub DX_line
 669 {
 670     my ($U,$V,$W,$Z) = @_; $W =~ s/<[^<>]*>//g;
 671     &dx_line ($U,$V,$W);
 672 }
 673
 674 sub dx_text
 675 {
 676     my ($U,$V,$Z) = @_;
 677     &dx_line ("=text=",$U,$V);
 678 }
 679
 680 sub DX_text   # add a <!--vars--> substition includings format variants
 681 {
 682     my ($N, $T,$XXX) = @_;
 683     $N = trimm($N); $T = trimm($T);
 684     if ($N) {
 685         if ($T) {
 686             my $text=lc("$T"); $text =~ s/<[^<>]*>//g;
 687             &dx_line ("=text=",$N,$T);
 688             &dx_line ("=name=",$N,$text);
 689             my $varname=$N; $varname =~ s/.*[.]//;  # cut out front part
 690             if ($N ne $varname and $varname) {
 691                 $text=lc("$varname $T"); $text =~ s/<[^<>]*>//g;
 692                 &dx_line ("=Text=",$varname,$T);
 693                 &dx_line ("=Name=",$varname,$text);
 694             }
 695         }
 696     }
 697 }
 698
 699 sub dx_meta
 700 {
 701     my ($U,$V,$Z) = @_;
 702     &DX_line ("=meta=",$U,$V);
 703 }
 704
 705 sub DX_meta  # add simple meta entry and its <!--vars--> subsitution
 706 {
 707     my ($U,$V,$Z) = @_;
 708     &DX_line ("=meta=",$U,$V);
 709     &DX_text ("$U", $V);
 710 }
 711
 712 sub DC_meta   # add new DC.meta entry plus two <!--vars--> substitutions
 713 {
 714     my ($U,$V,$Z) = @_;
 715     &DX_line ("=meta=","DC.$U",$V);
 716     &DX_text ("DC.$U", $V);
 717     &DX_text ("$U", $V);
 718 }
 719
 720 sub HTTP_meta   # add new HTTP.meta entry plus two <!--vars--> substitutions
 721 {
 722     my ($U,$V,$Z) = @_;
 723     &DX_line ("=meta=","HTTP.$U",$V);
 724     &DX_text ("HTTP.$U", $V);
 725     &DX_text ("$U", $V);
 726 }
 727
 728 sub DC_VARS_Of # check DC vars as listed in $DC_VARS global/generate DC_meta
 729 {                 # the results will be added to .meta.tmp and .vars.tmp later
 730     my ($FILENAME,$Z)= @_;
 731     $FILENAME=$SOURCEFILE if not $FILENAME;
 732     for my $M (@DC_VARS, "title") {
 733         # scan for a <markup> of this name                  FIXME
 734         my ($part,$text);
 735         for (source($FILENAME)) {
 736             /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 737             $part = trimm($_); last;
 738         }
 739         $text=$part;  $text =~ s|^\w*:||; $text = trimm($text);
 740         next if not $text;
 741         # <mark:part> will be <meta name="mark.part">
 742         if ($text ne $part) {
 743             my $N=$part; $N =~ s/:.*//;
 744             &DC_meta ("$M.$N", $text);
 745         } elsif ($M eq "date") {
 746             &DC_meta ("$M.issued", $text); # "<date>" -> "<date>issued:"
 747         } else {
 748             &DC_meta ("$M", $text);
 749         }
 750     }
 751 }
 752
 753 sub HTTP_VARS_Of  # check HTTP-EQUIVs as listed in $_EQUIV global then
 754 {                 # generate meta tags that are http-equiv= instead of name=
 755     my ($FILENAME,$Z)= @_;
 756     $FILENAME=$SOURCEFILE if not $FILENAME;
 757     for my $M (@_EQUIVS) {
 758         # scan for a <markup> of this name                  FIXME
 759         my ($part,$text);
 760         for (source($FILENAME)) {
 761             /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 762             $part = trimm($_); last;
 763         }
 764         $text=$part;  $text =~ s|^\w*:||; $text = trimm($text);
 765         next if not $text;
 766         if ($M eq "redirect") {
 767             &HTTP_meta ("refresh", "5; url=$text"); &DX_text ("$M", $text);
 768         } elsif ($M eq "charset") {
 769             &HTTP_meta ("content-type", "text/html; charset=$text");
 770         } else {
 771             &HTTP_meta ("$M", $text);
 772         }
 773     }
 774 }
 775
 776 sub DC_isFormatOf   # make sure there is this DC.relation.isFormatOf tag
 777 {                      # choose argument for a fallback (usually $SOURCEFILE)
 778     my ($NAME,$Z) = @_;
 779     $NAME=$SOURCEFILE if not $NAME;
 780     if (not &info1grep ("DC.relation.isFormatOf")) {
 781         &DC_meta ("relation.isFormatOf", "$NAME");
 782     }
 783 }
 784
 785 sub DC_publisher    # make sure there is this DC.publisher meta tag
 786 {                      # choose argument for a fallback (often $USER)
 787     my ($NAME,$Z) = @_;
 788     $NAME=$ENV{"USER"} if not $NAME;
 789     if (not &info1grep ("DC.publisher")) {
 790         &DC_meta ("publisher", "$NAME");
 791     }
 792 }
 793
 794 sub DC_modified     # make sure there is a DC.date.modified meta tag
 795 {                      # maybe choose from filesystem dates if possible
 796     my ($Q,$Z) = @_; # target file
 797     if (not &info1grep ("DC.date.modified")) {
 798         my @stats = stat($Q);
 799         my $text =  strftime("%Y-%m-%d", localtime($stats[9]));
 800         &DC_meta ("date.modified", $text);
 801     }
 802 }
 803
 804 sub DC_date         # make sure there is this DC.date meta tag
 805 {                      # choose from one of the available DC.date.* specials
 806     my ($Q,$Z) = @_; # source file
 807     if (&info1grep ("DC.date")) {
 808         &DX_text ("issue", "dated ".&info_get_entry("DC.date"));
 809         &DX_text ("updated", &info_get_entry("DC.date"));
 810     } else {
 811         my $text=""; my $kind;
 812         for $kind (qw/available issued modified created/) {
 813             $text=&info_get_entry("DC.date.$kind");
 814             # test ".$text" != "." && echo "$kind = date = $text ($Q)"
 815             last if $text;
 816         }
 817         if (not $text) {
 818             my $part; my $M="date";
 819             for (source($Q)) {
 820                 /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 821                 $part=trimm($_); last;
 822             }
 823             $text=$part; $text =~ s|^[$AA]*:||;
 824             $text = &trimm ($text);
 825         }
 826         if (not $text) {
 827             my $part; my $M="!--date:*=*--"; # takeover updateable variable...
 828             for (source($Q)) {
 829                 /<$M>/ or next; s|.*<$M>||; s|</.*||;
 830                 $part=trimm($_); last;
 831             }
 832             $text=$part; $text =~ s|^[$AA]*:||; $text =~ s|\&.*||;
 833             $text = &trimm ($text);
 834         }
 835         $text =~ s/[$NN]*:.*//; # cut way seconds
 836         &DX_text ("updated", $text);
 837         my $text1=$text; $text1 =~ s|^.* *updated ||;
 838         if ($text ne $text1) {
 839             $kind="modified" ; $text=$text1; $text =~ s|,.*||;
 840         }
 841         $text1=$text; $text1 =~ s|^.* *modified ||;
 842         if ($text ne $text1) {
 843             $kind="modified" ; $text=$text1; $text =~ s|,.*||;
 844         }
 845         $text1=$text; $text1 =~ s|^.* *created ||;
 846         if ($text ne $text1) {
 847             $kind="created" ; $text=$text1; $text =~ s|,.*||;
 848         }
 849         &DC_meta ("date", "$text");
 850         &DX_text ("issue", "$kind $text");
 851     }
 852 }
 853
 854 sub DC_title
 855 {
 856     # choose a title for the document, either an explicit title-tag
 857     # or one of the section headers in the document or fallback to filename
 858     my ($Q,$Z) = @_; # target file
 859     my ($term, $text);
 860     if (not &info1grep ("DC.title")) {
 861         for my $M (qw/TITLE title H1 h1 H2 h2 H3 H3 H4 H4 H5 h5 H6 h6/) {
 862             for (source($Q)) {
 863                 /<$M>/ or next; s|.*<$M>||; s|</$M>.*||;
 864                 $text = trimm($_); last;
 865             }
 866             last if $text;
 867             for (source($Q)) {
 868                 /<$M [^<>]*>/ or next; s|.*<$M [^<>]*>||; s|</$M>.*||;
 869                 $text = trimm($_); last;
 870             }
 871             last if $text;
 872         }
 873         if (not $text) {
 874             $text=basename($Q,".html");
 875             $text=basename($text,".htm"); $text =~ y/_/ /; $text =~ s/$/ info/;
 876             $text=~ s/\n/      /g;
 877         }
 878         $term=$text; $term =~ s/.*[\(]//; $term =~ s/[\)].*//;
 879         $text =~ s/[\(][^\(\)]*[\)]//;
 880         if (not $term or $term eq $text) {
 881             &DC_meta ("title", "$text");
 882         } else {
 883             &DC_meta ("title", "$term - $text");
 884         }
 885     }
 886 }
 887
 888 sub site_get_section # return parent section page of given page
 889 {
 890     my $_F_ = &sed_slash_key(@_);
 891     for my $x (grep {/=sect=$_F_ /} @MK_INFO) {
 892         my $info = $x; $info =~ s/=sect=[^ ]* //; return $info;
 893     }
 894 }
 895
 896 sub DC_section # not really a DC relation (shall we use isPartOf ?)
 897 {                 # each document should know its section father
 898     my $sectn = &site_get_section($F);
 899      if ($sectn) {
 900         &DC_meta ("relation.section", $sectn);
 901     }
 902 }
 903
 904 sub info_get_entry_section
 905 {
 906     return &info_get_entry("DC.relation.section");
 907 }
 908
 909 sub site_get_selected  # return section of given page
 910 {
 911     my $_F_ = &sed_slash_key(@_);
 912     for my $x (grep {/=[u]se.=$_F_ /} @MK_INFO) {
 913         my $info = $x; $info =~ s/=[u]se.=[^ ]* //; return $info;
 914     }
 915 }
 916
 917 sub DC_selected # not really a DC title (shall we use alternative ?)
 918 {
 919     # each document might want to highlight the currently selected item
 920     my $short=&site_get_selected($F);
 921     if ($short) {
 922         &DC_meta ("title.selected", $short);
 923     }
 924 }
 925
 926 sub info_get_entry_selected
 927 {
 928     return &info_get_entry("DC.title.selected");
 929 }
 930
 931 sub site_get_rootsections # return all sections from root of nav tree
 932 {
 933     my @OUT;
 934     for (grep {/=[u]se1=/} @MK_INFO) {
 935         my $x = $_;
 936         $x =~ s/=[u]se.=([^ ]*) .*/$1/;
 937         push @OUT, $x;
 938     }
 939     return @OUT;
 940 }
 941
 942 sub site_get_sectionpages # return all children pages in the given section
 943 {
 944     my $_F_=&sed_slash_key(@_);
 945     my @OUT = ();
 946     for (grep {/^=sect=[^ ]* $_F_$/} @MK_INFO) {
 947         my $x = $_;
 948         $x =~ s/^=sect=//; $x =~ s/ .*//;
 949         push @OUT, $x;
 950     }
 951     return @OUT;
 952 }
 953
 954 sub site_get_subpages # return all page children of given page
 955 {
 956     my $_F_=&sed_slash_key(@_);
 957     my @OUT = ();
 958     for (grep {/^=node=[^ ]* $_F_$/} @MK_INFO) {
 959         my $x = $_;
 960         $x =~ s/^=node=//; $x =~ s/ .*//;
 961         push @OUT, $x;
 962     }
 963     return @OUT;
 964 }
 965
 966 sub site_get_parentpage # ret parent page for given page (".." for sections)
 967 {
 968     my $_F_=&sed_slash_key(@_);
 969     for (grep {/^=node=$_F_ /} @MK_INFO) {
 970         my $x = $_;
 971         $x =~ s/^=node=[^ ]* //;
 972         return $x;
 973     }
 974 }
 975
 976 sub DX_alternative    # detect wether page asks for alternative style
 977 {                        # which is generally a shortpage variant
 978     my ($U,$Z) = @_;
 979     my $x=&mksite_magic_option("alternative",$U);
 980     $x =~ s/^ *//; $x =~s/ .*//;
 981     if ($x) {
 982         &DX_text ("alternative", $x);
 983     }
 984 }
 985
 986 sub info2head_sed  # append alternative handling script to $HEAD
 987 {
 988     my @OUT = ();
 989     my $have=&info_get_entry("alternative");
 990     if ($have) {
 991         push @OUT, "/<!--mksite:alternative:$have .*-->/ && do {";
 992         push @OUT, "s/<!--mksite:alternative:$have( .*)-->/\$1/";
 993         push @OUT, "$sed_add \$_; last; };";
 994     }
 995     return @OUT;
 996 }
 997 sub info2body_sed  # append alternative handling script to $BODY
 998 {
 999     my @OUT = ();
1000     my $have=&info_get_entry("alternative");
1001     if ($have) {
1002         push @OUT, "s/<!--mksite:alternative:$have( .*)-->/\$1/";
1003     }
1004     return @OUT;
1005 }
1006
1007 sub bodymaker_for_sectioninfo
1008 {
1009     if ($sectioninfo eq "no") { return ""; }
1010     my $_x_="<!--mksite:sectioninfo::-->";
1011     my $_q_="([^<>]*[$AX][^<>]*)";
1012     $_q_="[ ][ ]*$sectioninfo([ ])" if $sectioninfo ne " ";
1013     my @OUT = ();
1014     push @OUT, "s|(^<[hH][$NN][ >].*</[hH][$NN]>)$_q_|\$1$_x_\$2|";
1015     push @OUT, "/$_x_/ and s|^|<table width=\"100%\"><tr valign=\"bottom\"><td>|";
1016     push @OUT, "/$_x_/ and s|</[hH][$NN]>|&</td><td align=\"right\"><i>|";
1017     push @OUT, "/$_x_/ and s|\$|</i></td></tr></table>|";
1018     push @OUT, "s|$_x_||";
1019     return @OUT;
1020 }
1021
1022 sub fast_href  # args "$FILETOREFERENCE" "$FROMCURRENTFILE:$F"
1023 {   # prints path to $FILETOREFERENCE href-clickable in $FROMCURRENTFILE
1024     # if no subdirectoy then output is the same as input $FILETOREFERENCE
1025     my ($T,$R,$Z) = @_;
1026     my $S=&back_path ($R);
1027     if (not $S) {
1028         return $T;
1029     } else {
1030         my $t=$T;
1031         $t =~ s/^ *$//; $t =~ s/^\/.*//;
1032         $t =~ s/^[.][.].*//; $t =~ s/^\w*:.*//;
1033         if (not $t) { # don't move any in the pattern above
1034             return $T;
1035         } else {
1036             return "$S$T";   # prefixed with backpath
1037         }
1038     }
1039 }
1040
1041 sub make_fast # experimental - make a FAST file that can be applied
1042 {             # to htm sourcefiles in a subdirectory of the sitefile.
1043 #   R="$1" ; test ".$R" = "." && R="$F"
1044     my ($R,$Z) = @_;
1045     my $S=&back_path ($R);
1046     my @OUT = ();
1047     if (not $S) {
1048         # echo "backpath '$F' = none needed"
1049         return @OUT;
1050     } else {
1051         #  print "backpath '$F' -> '$S'$n";
1052         my @hrefs = ();
1053         for (source($SITEFILE)) {
1054             /href=\"[^\"]*\"/ or next;
1055             s/.*href=\"//; s/\".*//; chomp;
1056             if (/^ *$/ || /^\// || /^[.][.]/ || /^[\w]*:/) { next; }
1057             push @hrefs, $_;
1058         }
1059         for (source($SOURCEFILE)) {
1060             /href=\"[^\"]*\"/ or next;
1061             s/.*href=\"//; s/\".*//; chomp;
1062             if (/^ *$/ || /^\// || /^[.][.]/ || /^[\w]*:/) { next; }
1063             push @hrefs, $_;
1064         }
1065         my $ref = "";
1066         for (sort(@hrefs)) {
1067             next if /\$/; # some href="${...}" is problematic
1068             next if $ref eq $_; $ref = $_; # uniq
1069             push @OUT, "s|href=\\\"$ref\\\"|href=\\\"$S$ref\\\"|;";
1070         }
1071         return @OUT;
1072     }
1073 }
1074
1075 # ============================================================== SITE MAP INFO
1076 # each entry needs atleast a list-title, a long-title, and a list-date
1077 # these are the basic information to be printed in the sitemap file
1078 # where it is bound the hierarchy of sect/subsect of the entries.
1079
1080 sub site_map_list_title # $file $text
1081 {
1082     my ($U,$V,$Z) = @_; chomp($U);
1083     push @MK_INFO, "=list=$U ".trimm($V);
1084 }
1085 sub info_map_list_title # $file $text
1086 {
1087     my ($U,$V,$Z) = @_; chomp($U);
1088     push @{$INFO{$U}}, "=list=".trimm($V);
1089 }
1090 sub site_map_long_title # $file $text
1091 {
1092     my ($U,$V,$Z) = @_; chomp($U);
1093     push @MK_INFO, "=long=$U ".trimm($V);
1094 }
1095 sub info_map_long_title # $file $text
1096 {
1097     my ($U,$V,$Z) = @_; chomp($U);
1098     push @{$INFO{$U}}, "=long=".trimm($V);
1099 }
1100 sub site_map_list_date # $file $text
1101 {
1102     my ($U,$V,$Z) = @_; chomp($U);
1103     push @MK_INFO, "=date=$U ".trimm($V);
1104 }
1105 sub info_map_list_date # $file $text
1106 {
1107     my ($U,$V,$Z) = @_; chomp($U);
1108     push @{$INFO{$U}}, "=date=".trimm($V);
1109 }
1110
1111 sub site_get_list_title
1112 {
1113     my ($U,$V,$Z) = @_;
1114     for (@MK_INFO) { if (m|^=list=$U (.*)|) { return $1; } } return "";
1115 }
1116 sub site_get_long_title
1117 {
1118     my ($U,$V,$Z) = @_;
1119     for (@MK_INFO) { if (m|^=long=$U (.*)|) { return $1; } } return "";
1120 }
1121 sub site_get_list_date
1122 {
1123     my ($U,$V,$Z) = @_;
1124     for (@MK_INFO) { if (m|^=date=$U (.*)|) { return $1; } } return "";
1125 }
1126
1127 sub siteinfo2sitemap# generate <name><page><date> addon sed scriptlet
1128 {                      # the resulting script will act on each item/line
1129                        # containing <!--"filename"--> and expand any following
1130                        # reference of <!--name--> or <!--date--> or <!--long-->
1131     my ($INP,$Z) = @_ ; $INP= \@MK_INFO if not $INP;
1132     my @OUT = ();
1133     my $_list_=
1134         sub{"s|<!--\\\"$1\\\"-->.*<!--name-->|\$\&<name href=\\\"$1\\\">$2</name>|"};
1135     my $_date_=
1136         sub{"s|<!--\\\"$1\\\"-->.*<!--date-->|\$\&<date>$2</date>|"};
1137     my $_long_=
1138         sub{"s|<!--\\\"$1\\\"-->.*<!--long-->|\$\&<long>$2</long>|"};
1139
1140     for (@$INP) {
1141         my $info = $_;
1142         $info =~ s:=list=([^ ]*) (.*):&$_list_:e;
1143         $info =~ s:=date=([^ ]*) (.*):&$_date_:e;
1144         $info =~ s:=long=([^ ]*) (.*):&$_long_:e;
1145         $info =~ /^s\|/ || next;
1146         push @OUT, $info;
1147     }
1148     return @OUT;
1149 }
1150
1151 sub make_multisitemap
1152 {  # each category gets its own column along with the usual entries
1153     my ($INPUTS,$Z)= @_ ; $INPUTS=\@MK_INFO if not $INPUTS;
1154     @MK_SITE = &siteinfo2sitemap(); # have <name><long><date> addon-sed
1155     my @OUT = ();
1156     my $_form_= sub{"<!--\"$2\"--><!--use$1--><!--long--><!--end$1-->"
1157                         ."<br><!--name--><!--date-->" };
1158     my $_tiny_="small><small><small" ; my $_tinyX_="small></small></small ";
1159     my $_tabb_="<br><$_tiny_> </$_tinyX_>" ; my $_bigg_="<big> </big>";
1160     push @OUT, "<table width=\"100%\"><tr><td> ".$n;
1161     for (grep {/=[u]se.=/} @$INPUTS) {
1162         my $x = $_;
1163         $x =~ s|=[u]se(.)=([^ ]*) .*|&$_form_|e;
1164         $x = &eval_MK_LIST($x, @MK_SITE); $x =~ /<name/ or next;
1165         $x =~ s|<!--[u]se1-->|</td><td valign=\"top\"><b>|;
1166         $x =~ s|<!--[e]nd1-->|</b>|;
1167         $x =~ s|<!--[u]se2-->|<br>|;
1168         $x =~ s|<!--[u]se.-->|<br>|; $x =~ s/<!--[^<>]*-->/ /g;
1169         $x =~ s|<long>||; $x =~ s|</long>||;
1170         $x =~ s|<name |<$_tiny_><a |; $x =~ s|</name>||;
1171         $x =~ s|<date>| |; $x =~ s|</date>|</a><br></$_tinyX_>|;
1172         push @OUT, $x.$n;
1173     }
1174     push @OUT, "</td><tr></table>".$n;
1175     return @OUT;
1176 }
1177
1178 sub make_listsitemap
1179 {   # traditional - the body contains a list with date and title extras
1180     my ($INPUTS,$Z)= @_ ; $INPUTS=\@MK_INFO if not $INPUTS;
1181     @MK_SITE = &siteinfo2sitemap(); # have <name><long><date> addon-sed
1182     my @OUT = ();
1183     my $_form_=sub{
1184         "<!--\"$2\"--><!--use$1--><!--name--><!--date--><!--long-->"};
1185     my $_tabb_="<td>\&nbsp\;</td>";
1186     push @OUT, "<table cellspacing=\"0\" cellpadding=\"0\">".$n;
1187     my $xx;
1188     for $xx (grep {/=[u]se.=/} @$INPUTS) {
1189         my $x = "".$xx;
1190         $x =~ s|=[u]se(.)=([^ ]*) .*|&$_form_|e;
1191         $x = &eval_MK_LIST($x, @MK_SITE); $x =~ /<name/ or next;
1192         $x =~ s|<!--[u]se(1)-->|<tr class=\"listsitemap$1\"><td>*</td>|;
1193         $x =~ s|<!--[u]se(2)-->|<tr class=\"listsitemap$1\"><td>-</td>|;
1194         $x =~ s|<!--[u]se(.)-->|<tr class=\"listsitemap$1\"><td> </td>|;
1195         $x =~  /<tr.class=\"listsitemap3\">/ and $x =~ s|<name [^<>]*>|$&- |;
1196         $x =~ s|<!--[^<>]*-->| |g;
1197         $x =~ s|<name href=\"name:sitemap:|<name href=\"|;
1198         $x =~ s|<name |<td><a |;     $x =~ s|</name>|</a></td>$_tabb_|;
1199         $x =~ s|<date>|<td><small>|; $x =~ s|</date>|</small></td>$_tabb_|;
1200         $x =~ s|<long>|<td><em>|;    $x =~ s|</long>|</em></td></tr>|;
1201         push @OUT, $x;
1202     }
1203     for $xx (grep {/=[u]se.=/} @$INPUTS) {
1204         my $x = $xx; $x =~ s/=[u]se.=name:sitemap://; $x =~ s:\s*::gs;
1205         if (-f $x) {
1206             for (grep {/<tr.class=\"listsitemap\d\">/} source($x)) {
1207                 push @OUT, $_;
1208             }
1209         }
1210     }
1211     push @OUT, "</table>".$n;
1212     return @OUT;
1213 }
1214
1215 sub print_extension
1216 {
1217     my ($ARG,$Z)= @_ ; $ARG=$o{print} if not $ARG;
1218     if ($ARG =~ /^([.-])/) {
1219         return $ARG;
1220     } else {
1221         return ".print";
1222     }
1223 }
1224
1225 sub html_sourcefile  # generally just cut away the trailing "l" (ell)
1226 {                       # making "page.html" argument into "page.htm" return
1227     my ($U,$Z) = @_;
1228     my $_SRCFILE_=$U; $_SRCFILE_ =~ s/l$//;
1229     if (-f $_SRCFILE_) {
1230         return $_SRCFILE_;
1231     } elsif (-f "$o{src_dir}/$_SRCFILE_") {
1232         return "$o{src_dir}/$_SRCFILE_";
1233     } else {
1234         return ".//$_SRCFILE_";
1235     }
1236 }
1237 sub html_printerfile_sourcefile
1238 {
1239     my ($U,$Z) = @_;
1240     if (not $printerfriendly) {
1241         $U =~ s/l\$//; return $U;
1242     } else {
1243         my $_ext_=&sed_slash_key(&print_extension($printerfriendly));
1244         $U =~ s/l\$//; $U =~ s/$_ext_([.][\w]*)$/$1/; return $U;
1245     }
1246 }
1247
1248 sub fast_html_printerfile {
1249     my ($U,$V,$Z) = @_;
1250     my $x=&html_printerfile($U) ; return basename($x);
1251 #   my $x=&html_printerfile($U) ; return &fast_href($x,$V);
1252 }
1253
1254 sub html_printerfile # generate the printerfile for a given normal output
1255 {
1256     my ($U,$Z) = @_;
1257     my $_ext_=&esc(&print_extension($printerfriendly));
1258     $U =~ s/([.][\w]*)$/$_ext_$1/; return $U; # index.html -> index.print.html
1259 }
1260
1261 sub make_printerfile_fast # generate s/file.html/file.print.html/ for hrefs
1262 {                        # we do that only for the $FILELIST
1263     my ($U,$Z) = @_;
1264     my $ALLPAGES=$U;
1265     my @OUT = ();
1266     for my $p (@$ALLPAGES) {
1267         my $a=&sed_slash_key($p);
1268         my $b=&html_printerfile($p);
1269         if ($b ne $p) {
1270             $b =~ s:/:\\/:g;
1271             push @OUT,
1272             "s/<a href=\\\"$a\\\"([^<>])*>/<a href=\\\"$b\\\"\$1>/;";
1273         }
1274     }
1275     return @OUT;
1276 }
1277
1278 sub echo_printsitefile_style
1279 {
1280     my $_bold_="text-decoration : none ; font-weight : bold ; ";
1281     return "   <style>"
1282         ."$n     a:link    { $_bold_ color : #000060 ; }"
1283         ."$n     a:visited { $_bold_ color : #000040 ; }"
1284         ."$n     body      { background-color : white ; }"
1285         ."$n   </style>"
1286         ."$n";
1287 }
1288
1289 sub make_printsitefile_head # $sitefile
1290 {
1291     my $MK_STYLE = &echo_printsitefile_style();
1292     my @OUT = ();
1293     for (source($SITEFILE)) {
1294         if (/<head>/) {  push @OUT, $_;
1295                          push @OUT, $MK_STYLE; next; }
1296         if (/<title>/) { push @OUT, $_; next; }
1297         if (/<\/head>/) { push @OUT, $_; next; }
1298         if (/<body>/) { push @OUT, $_; next; }
1299         if (/<link [^<>]*rel=\"shortcut icon\"[^<>]*>/) {
1300             push @OUT, $_; next;
1301         }
1302     }
1303     return @OUT;
1304 }
1305
1306 # ------------------------------------------------------------------------
1307 # The printsitefile is a long text containing html href markups where
1308 # each of the href lines in the file is being prefixed with the section
1309 # relation. During a secondary call the printsitefile can grepp'ed for
1310 # those lines that match a given output fast-file. The result is a
1311 # navigation header with 1...3 lines matching the nesting level
1312
1313 # these alt-texts will be only visible in with a text-mode browser:
1314 my $printsitefile_square="width=\"8\" height=\"8\" border=\"0\"";
1315 my $printsitefile_img_1="<img alt=\"|go text:\" $printsitefile_square />";
1316 my $printsitefile_img_2="<img alt=\"||topics:\" $printsitefile_square />";
1317 my $printsitefile_img_3="<img alt=\"|||pages:\" $printsitefile_square />";
1318 my $_SECT="mksite:sect:";
1319
1320 sub echo_current_line # $sect $extra
1321 {
1322     # add the prefix which is used by select_in_printsitefile to cut out things
1323     my ($N,$M,$Z) = @_;
1324     return "<!--$_SECT\"$N\"-->$M";
1325 }
1326 sub make_current_entry # $sect $file      ## requires $MK_SITE
1327 {
1328     my ($S,$R,$Z) = @_;
1329     my $RR=&sed_slash_key($R);
1330     my $sep=" - " ; my $_left_=" [ " ; my $_right_=" ] ";
1331     my $name = site_get_list_title($R);
1332     $_ = &echo_current_line ("$S", "<a href=\"$R\">$name</a>$sep");
1333     if ($R eq $S) {
1334         s/<a href/$_left_$&/;
1335         s/<\/a>/$&$_right_/;
1336     }
1337     return $_;
1338 }
1339 sub echo_subpage_line # $sect $extra
1340 {
1341     my ($N,$M,$Z) = @_;
1342     return "<!--$_SECT*:\"$N\"-->$M";
1343 }
1344
1345 sub make_subpage_entry
1346 {
1347     my ($S,$R,$Z) = @_;
1348     my $RR=&sed_slash_key($R);
1349     my $sep=" - " ;
1350     my $name = site_get_list_title($R);
1351     $_ = &echo_subpage_line ("$S", "<a href=\"$R\">$name</a>$sep");
1352     return $_;
1353 }
1354
1355 sub make_printsitefile
1356 {
1357    # building the printsitefile looks big but its really a loop over sects
1358     my ($INPUTS,$Z) = @_; $INPUTS=\@MK_INFO if not $INPUTS;
1359     @MK_SITE = &siteinfo2sitemap(); # have <name><long><date> addon-sed
1360     savelist(\@MK_SITE);
1361     my @OUT = &make_printsitefile_head ($SITEFILE);
1362
1363     my $sep=" - " ;
1364     my $_sect1=
1365         "<a href=\"#.\" title=\"section\">$printsitefile_img_1</a> ||$sep";
1366     my $_sect2=
1367         "<a href=\"#.\" title=\"topics\">$printsitefile_img_2</a> ||$sep";
1368     my $_sect3=
1369         "<a href=\"#.\" title=\"pages\">$printsitefile_img_3</a> ||$sep";
1370
1371     my $_SECT1="mksite:sect1";
1372     my $_SECT2="mksite:sect2";
1373     my $_SECT3="mksite:sect3";
1374
1375     @MK_SECT1 = &site_get_rootsections();
1376     # round one - for each root section print a current menu
1377     for my $r (@MK_SECT1) {
1378         push @OUT, &echo_current_line ("$r", "<!--$_SECT1:A--><br>$_sect1");
1379         for my $s (@MK_SECT1) {
1380             push @OUT, &make_current_entry ("$r", "$s");
1381         }
1382         push @OUT, &echo_current_line ("$r", "<!--$_SECT1:Z-->");
1383     }
1384
1385     # round two - for each subsection print a current and subpage menu
1386     for my $r (@MK_SECT1) {
1387     @MK_SECT2 = &site_get_subpages ("$r");
1388     for my $s (@MK_SECT2) {
1389         push @OUT, &echo_current_line ("$s", "<!--$_SECT2:A--><br>$_sect2");
1390         for my $t (@MK_SECT2) {
1391             push @OUT, &make_current_entry ("$s", "$t");
1392         } # "$t"
1393         push @OUT, &echo_current_line  ("$s", "<!--$_SECT2:Z-->");
1394     } # "$s"
1395         my $_have_children_="";
1396         for my $t (@MK_SECT2) {
1397             if (not $_have_children_) {
1398         push @OUT, &echo_subpage_line ("$r", "<!--$_SECT2:A--><br>$_sect2"); }
1399             $_have_children_ .= "1";
1400             push @OUT, &make_subpage_entry ("$r", "$t");
1401         }
1402             if ($_have_children_) {
1403         push @OUT, &echo_subpage_line ("$r", "<!--$_SECT2:Z-->"); }
1404     } # "$r"
1405
1406     # round three - for each subsubsection print a current and subpage menu
1407     for my $r (@MK_SECT1) {
1408     @MK_SECT2 = &site_get_subpages ("$r");
1409     for my $s (@MK_SECT2) {
1410     @MK_SECT3 = &site_get_subpages ("$s");
1411     for my $t (@MK_SECT3) {
1412         push @OUT, &echo_current_line ("$t", "<!--$_SECT3:A--><br>$_sect3");
1413         for my $u (@MK_SECT3) {
1414             push @OUT, &make_current_entry ("$t", "$u");
1415         } # "$t"
1416         push @OUT, &echo_current_line  ("$t", "<!--$_SECT3:Z-->");
1417     } # "$t"
1418         my $_have_children_="";
1419         for my $u (@MK_SECT3) {
1420             if (not $_have_children_) {
1421         push @OUT, &echo_subpage_line ("$s", "<!--$_SECT3:A--><br>$_sect3"); }
1422             $_have_children_ .= "1";
1423             push @OUT, &make_subpage_entry ("$s", "$u");
1424         }
1425             if ($_have_children_) {
1426         push @OUT, &echo_subpage_line ("$s", "<!--$_SECT3:Z-->"); }
1427     } # "$s"
1428     } # "$r"
1429     push @OUT, "<a name=\".\"></a>";
1430     push @OUT, "</body></html>";
1431     return @OUT;
1432 }
1433
1434 # create a selector that can grep a printsitefile for the matching entries
1435 sub select_in_printsitefile # arg = "page" : return to stdout >> $P.$HEAD
1436 {
1437     my ($N,$Z) = @_;
1438     my $_selected_="$N" ; $_selected_="$F" if not $_selected_;
1439     my $_section_=&sed_slash_key($_selected_);
1440     my @OUT = ();
1441     push @OUT, "s/^<!--$_SECT\\\"$_section_\\\"-->//;";        # sect3
1442     push @OUT, "s/^<!--$_SECT\[*\]:\\\"$_section_\\\"-->//;";    # children
1443     $_selected_=&site_get_parentpage($_selected_);
1444     if ($F =~ /testscript/) { print "($F)parent=$_selected_$n"; }
1445     $_section_=&sed_slash_key($_selected_);
1446     push @OUT, "s/^<!--$_SECT\\\"$_section_\\\"-->//;";        # sect2
1447     $_selected_=&site_get_parentpage($_selected_);
1448     $_section_=&sed_slash_key($_selected_);
1449     push @OUT, "s/^<!--$_SECT\\\"$_section_\\\"-->//;";        # sect1
1450     push @OUT, "/^<!--$_SECT\\\"[^\\\"]*\\\"-->/ and next;";
1451     push @OUT, "/^<!--$_SECT\[*\]:\\\"[^\\\"]*\\\"-->/ and next;";
1452     push @OUT, "s/^<!--mksite:sect[$NN]:[$AZ]-->//;";
1453     return @OUT;
1454 }
1455
1456 sub body_for_emailfooter
1457 {
1458     return "" if $emailfooter eq "no";
1459     my $_email_=$emailfooter; $_email_ =~ s|[?].*||;
1460     my $_dated_=&info_get_entry("updated");
1461     return "<hr><table border=\"0\" width=\"100%\"><tr><td>"
1462         ."$n"."<a href=\"mailto:$emailfooter\">$_email_</a>"
1463         ."$n"."</td><td align=\"right\">"
1464         ."$n"."$_dated_</td></tr></table>"
1465         ."$n";
1466 }
1467
1468 # ==========================================================================
1469 #
1470 #  During processing we will create a series of intermediate files that
1471 #  store relations. They all have the same format being
1472 #   =relationtype=key value
1473 #  where key is usually s filename or an anchor. For mere convenience
1474 #  we assume that the source html text does not have lines that start
1475 #  off with =xxxx= (btw, ye remember perl section notation...). Of course
1476 #  any other format would be usuable as well.
1477 #
1478
1479 # we scan the SITEFILE for href references to be converted
1480 # - in the new variant we use a ".gets.tmp" sed script that            SECTS
1481 # marks all interesting lines so they can be checked later
1482 # with an sed anchor of <!--sect[$NN]--> (or <!--sect[$AZ]-->)
1483 my $S="\\&nbsp\\;";
1484 # S="[&]nbsp[;]"
1485
1486 # HR and EM style markups must exist in input - BR sometimes left out
1487 # these routines in(ter)ject hardspace before, between, after markups
1488 # note that "<br>" is sometimes used with HR - it must exist in input
1489 sub echo_HR_EM_PP
1490 {
1491     my ($U,$V,$W,$X,$Z) = @_;
1492     my @list = (
1493                 "/^$U$V$W*<a href=/   and s/^/$X/;",
1494                 "/^<>$U$V$W*<a href=/ and s/^/$X/;",
1495                 "/^$S$U$V$W*<a href=/ and s/^/$X/;",
1496                 "/^$U<>$V$W*<a href=/ and s/^/$X/;",
1497                 "/^$U$S$V$W*<a href=/ and s/^/$X/;",
1498                 "/^$U$V<>$W*<a href=/ and s/^/$X/;",
1499                 "/^$U$V$S$W*<a href=/ and s/^/$X/;" );
1500     return @list;
1501 }
1502
1503 sub echo_br_EM_PP
1504 {
1505     my ($U,$V,$W,$X,$Z) = @_;
1506     my @list = &echo_HR_EM_PP  ("$U", "$V", "$W", "$X");
1507     my @listt = (
1508                  "/^$V$W*<a href=/   and s/^/$X/;",
1509                  "/^<>$V$W*<a href=/ and s/^/$X/;",
1510                  "/^$S$V$W*<a href=/ and s/^/$X/;",
1511                  "/^$V<>$W*<a href=/ and s/^/$X/;",
1512                  "/^$V$S$W*<a href=/ and s/^/$X/;" );
1513     push @list, @listt;
1514     return @list;
1515 }
1516
1517 sub echo_HR_PP
1518 {
1519     my ($U,$V,$W,$Z) = @_;
1520     my @list = (
1521                 "/^$U$V*<a href=/   and s/^/$W/;",
1522                 "/^<>$U$V*<a href=/ and s/^/$W/;",
1523                 "/^$S$U$V*<a href=/ and s/^/$W/;",
1524                 "/^$U<>$V*<a href=/ and s/^/$W/;",
1525                 "/^$U$S$V*<a href=/ and s/^/$W/;" );
1526     return @list;
1527 }
1528 sub echo_br_PP
1529 {
1530     my ($U,$V,$W,$Z) = @_;
1531     my @list = &echo_HR_PP ("$U", "$V", "$W");
1532     my @listt = (
1533                  "/^$V*<a href=/   and s/^/$W/;",
1534                  "/^<>$V*<a href=/ and s/^/$W/;",
1535                  "/^$S$V*<a href=/ and s/^/$W/;" );
1536     push @list, @listt;
1537     return @list;
1538 }
1539 sub echo_sp_PP
1540 {
1541     my ($U,$V,$Z) = @_;
1542     my @list = (
1543                 "/^<>$U*<a href=/ and s/^/$V/;",
1544                 "/^$S$U*<a href=/ and s/^/$V/;",
1545                 "/^<><>$U*<a href=/ and s/^/$V/;",
1546                 "/^$S$S$U*<a href=/ and s/^/$V/;",
1547                 "/^<>$U<>*<a href=/ and s/^/$V/;",
1548                 "/^$S$U$S*<a href=/ and s/^/$V/;",
1549                 "/^$U<><>*<a href=/ and s/^/$V/;",
1550                 "/^$U$S$S*<a href=/ and s/^/$V/;",
1551                 "/^$U<>*<a href=/ and s/^/$V/;",
1552                 "/^$U$S*<a href=/ and s/^/$V/;" );
1553     return @list;
1554 }
1555 sub echo_sp_sp
1556 {
1557     my ($U,$V,$Z) = @_;
1558     my @list = (
1559                 "/^$U*<a name=/ and s/^/$V/;",
1560                 "/^<>$U*<a name=/ and s/^/$V/;",
1561                 "/^$S$U*<a name=/ and s/^/$V/;",
1562                 "/^<><>$U*<a name=/ and s/^/$V/;",
1563                 "/^$S$S$U*<a name=/ and s/^/$V/;",
1564                 "/^<>$U<>*<a name=/ and s/^/$V/;",
1565                 "/^$S$U$S*<a name=/ and s/^/$V/;",
1566                 "/^$U<><>*<a name=/ and s/^/$V/;",
1567                 "/^$U$S$S*<a name=/ and s/^/$V/;",
1568                 "/^$U<>*<a name=/ and s/^/$V/;",
1569                 "/^$U$S*<a name=/ and s/^/$V/;" );
1570     return @list;
1571 }
1572
1573 sub make_sitemap_init
1574 {
1575     # build a list of detectors that map site.htm entries to a section table
1576     # note that the resulting .gets.tmp / .puts.tmp are real sed-script
1577     my $h1="[-|[]";
1578     my $b1="[*=]";
1579     my $b2="[-|[]";
1580     my $b3="[\\/:]";
1581     my $q3="[\\/:,[]";
1582     @MK_GETS = ();
1583     push @MK_GETS, &echo_HR_PP   ("<hr>",            "$h1",    "<!--sect1-->");
1584     push @MK_GETS, &echo_HR_EM_PP("<hr>","<em>",     "$h1",    "<!--sect1-->");
1585     push @MK_GETS, &echo_HR_EM_PP("<hr>","<strong>", "$h1",    "<!--sect1-->");
1586     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$b1$b1", "<!--sect1-->");
1587     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$b2$b2", "<!--sect2-->");
1588     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$b3$b3", "<!--sect3-->");
1589     push @MK_GETS, &echo_br_PP   ("<br>",          , "$b2$b2", "<!--sect2-->");
1590     push @MK_GETS, &echo_br_PP   ("<br>",          , "$b3$b3", "<!--sect3-->");
1591     push @MK_GETS, &echo_br_EM_PP("<br>","<small>" , "$q3"   , "<!--sect3-->");
1592     push @MK_GETS, &echo_br_EM_PP("<br>","<em>"    , "$q3"   , "<!--sect3-->");
1593     push @MK_GETS, &echo_br_EM_PP("<br>","<u>"     , "$q3"   , "<!--sect3-->");
1594     push @MK_GETS, &echo_HR_PP   ("<br>",          , "$q3"   , "<!--sect3-->");
1595     push @MK_GETS, &echo_sp_PP   (                   "$q3"   , "<!--sect3-->");
1596     push @MK_GETS, &echo_sp_sp   (                   "$q3"   , "<!--sect9-->");
1597     @MK_PUTS = map { my $x=$_; $x =~ s/(>)(\[)/$1 *$2/; $x } @MK_GETS;
1598     # the .puts.tmp variant is used to <b><a href=..></b> some hrefs which
1599     # shall not be used otherwise for being generated - this is nice for
1600     # some quicklinks somewhere. The difference: a whitspace "<hr> <a...>"
1601 }
1602
1603 my $_uses_= sub{"=use$1=$2 $3" }; my $_name_= sub{"=use$1=name:$2 $3" };
1604 my $_getW_="<!--sect([$NN])-->";
1605 my $_getX_="<!--sect([$NN])--><[^<>]*>[^<>]*";
1606 my $_getY_="<!--sect([$NN])--><[^<>]*>[^<>]*<[^<>]*>[^<>]*";
1607
1608 sub make_sitemap_list
1609 {
1610     # scan sitefile for references pages - store as "=use+=href+ anchortext"
1611     for (source($SITEFILE)) {
1612 #       print join("$n;",@MK_GETS),$n;
1613         $_ = &eval_MK_LIST($_, @MK_GETS);
1614         /^<!--sect[$NN]-->/ or next;
1615         s{^$_getX_<a href=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_uses_}e;
1616         s{^$_getY_<a href=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_uses_}e;
1617         s{^$_getW_<a name=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_name_}e;
1618         s{^$_getX_<a name=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_name_}e;
1619         s{^$_getY_<a name=\"([^\"]*)\"[^<>]*>(.*)</a>.*}{&$_name_}e;
1620         /^=....=/ or next;
1621         push @MK_INFO, $_;
1622     }
1623 }
1624
1625 sub make_sitemap_sect
1626 {
1627     # scan used pages and store prime section group relation =sect= and =node=
1628     # (A) each "use1" creates "=sect=href+ href1" for all following non-"use1"
1629     # (B) each "use1" creates "=node=href2 href1" for all following "use2"
1630     my $sect = "";
1631     for (grep {/=[u]se.=/} @MK_INFO) {
1632         if (/=[u]se1=([^ ]*) .*/) { $sect = $1; }
1633         my $x = $_; $x =~ s/=[u]se.=([^ ]*) .*/=sect=$1/; chomp $x;
1634         push @MK_INFO, "$x $sect";
1635     }
1636     for (grep {/=[u]se.=/} @MK_INFO) {
1637         if (/=[u]se1=([^ ]*) .*/) { $sect = $1; }
1638         /=[u]se[13456789]=/ and next;
1639         my $x = $_; $x =~ s/=[u]se.=([^ ]*) .*/=node=$1/; chomp $x;
1640         push @MK_INFO, "$x $sect";
1641     }
1642 }
1643
1644 sub make_sitemap_page
1645 {
1646     # scan used pages and store secondary group relation =page= and =node=
1647     # the parenting =node= for use3 is usually a use2 (or use1 if none there)
1648     my $sect = "";
1649     for (grep {/=[u]se.=/} @MK_INFO) {
1650         if (/=[u]se1=([^ ]*) .*/) { $sect = $1; }
1651         if (/=[u]se2=([^ ]*) .*/) { $sect = $1; }
1652         /=[u]se[1]=/ and next;
1653         my $x = $_; $x =~ s/=[u]se.=([^ ]*) .*/=page=$1/; chomp $x;
1654         push @MK_INFO, "$x $sect";
1655     }
1656     for (grep {/=[u]se.=/} @MK_INFO) {
1657         if (/=[u]se1=([^ ]*) .*/) { $sect = $1; }
1658         if (/=[u]se2=([^ ]*) .*/) { $sect = $1; }
1659         /=[u]se[12456789]=/ and next;
1660         my $x = $_; $x =~ s/=[u]se.=([^ ]*) .*/=node=$1/; chomp $x;
1661         push @MK_INFO, "$x $sect"; print "(",$_,")","$x $sect", $n;
1662     }
1663     # and for the root sections we register ".." as the parenting group
1664     for (grep {/=[u]se1=/} @MK_INFO) {
1665         my $x = $_; $x =~ s/=[u]se.=([^ ]*) .*/=node=$1/; chomp $x;
1666         push @MK_INFO, trimm("$x ..");
1667     }
1668 }
1669 sub echo_site_filelist
1670 {
1671     my @OUT = ();
1672     for (grep {/=[u]se.=/} @MK_INFO) {
1673         my $x = $_; $x =~ s/=[u]se.=//; $x =~ s/ .*[\n]*//;
1674         push @OUT, $x;
1675     }
1676     return @OUT;
1677 }
1678
1679 # ==========================================================================
1680 # originally this was a one-pass compiler but the more information
1681 # we were scanning out the more slower the system ran - since we
1682 # were rescanning files for things like section information. Now
1683 # we scan the files first for global information.
1684 #                                                                    1.PASS
1685
1686 sub scan_sitefile # $F
1687 {
1688     $SOURCEFILE=&html_sourcefile($F);
1689     if ($SOURCEFILE ne $F) {
1690         dx_init "$F";
1691         dx_text ("today", &timetoday());
1692         my $short=$F;
1693         $short =~ s:.*/::; $short =~ s:[.].*::; # basename for all exts
1694         $short .=" ~";
1695         DC_meta ("title", "$short");
1696         DC_meta ("date.available", &timetoday());
1697         DC_meta ("subject", "sitemap");
1698         DC_meta ("DCMIType", "Collection");
1699         DC_VARS_Of ($SOURCEFILE) ; HTTP_VARS_Of ($SOURCEFILE) ;
1700         DC_modified ($SOURCEFILE) ; DC_date ($SOURCEFILE);
1701         DC_section ($F);
1702         DX_text ("date.formatted", &timetoday());
1703         if ($printerfriendly) {
1704             DX_text ("printerfriendly", fast_html_printerfile($F)); }
1705         if ($ENV{USER}) { DC_publisher ($ENV{USER}); }
1706         print "'$SOURCEFILE': $short (sitemap)$n";
1707         site_map_list_title ($F, "$short");
1708         site_map_long_title ($F, "generated sitemap index");
1709         site_map_list_date  ($F, &timetoday());
1710     }
1711 }
1712
1713 sub scan_htmlfile # "$F"
1714 {
1715     my ($FF,$Z) = @_;
1716     $SOURCEFILE=&html_sourcefile($F);                                  # SCAN :
1717     if ($SOURCEFILE ne $F) {                                           # HTML :
1718     if ( -f $SOURCEFILE) {
1719         @{$FAST{$F}} = &make_fast ($F);
1720         dx_init "$F";
1721         dx_text ("today", &timetoday());
1722         dx_text ("todays", &timetodays());
1723         DC_VARS_Of ($SOURCEFILE); HTTP_VARS_Of ($SOURCEFILE);
1724         DC_title ($SOURCEFILE);
1725         DC_isFormatOf ($SOURCEFILE);
1726         DC_modified ($SOURCEFILE);
1727         DC_date ($SOURCEFILE); DC_date ($SITEFILE);
1728         DC_section ($F);  DC_selected ($F);  DX_alternative ($SOURCEFILE);
1729         if ($ENV{USER}) { DC_publisher ($ENV{USER}); }
1730         DX_text ("date.formatted", &timetoday());
1731         if ($printerfriendly) {
1732             DX_text ("printerfriendly", fast_html_printerfile($F)); }
1733         my $sectn=&info_get_entry("DC.relation.section");
1734         my $short=&info_get_entry("DC.title.selected");
1735         &site_map_list_title ($F, "$short");
1736         &info_map_list_title ($F, "$short");
1737         my $title=&info_get_entry("DC.title");
1738         &site_map_long_title ($F, "$title");
1739         &info_map_long_title ($F, "$title");
1740         my $edate=&info_get_entry("DC.date");
1741         my $issue=&info_get_entry("issue");
1742         &site_map_list_date ($F, "$edate");
1743         &info_map_list_date ($F, "$edate");
1744         print "'$SOURCEFILE':  '$title' ('$short') @ '$issue' ('$sectn')$n";
1745     }else {
1746         print "'$SOURCEFILE': does not exist$n";
1747         site_map_list_title ($F, "$F");
1748         site_map_long_title ($F, "$F (no source)");
1749     }
1750     } else {
1751         print "<$F> - skipped - ($SOURCEFILE)$n";
1752     }
1753 }
1754
1755 sub scan_namespec
1756 {
1757     # nothing so far
1758     # my ($F,$ZZZ) = @_;
1759     if ($F =~ /^name:sitemap:/) {
1760         my $short=$F;
1761         $short =~ s:.*/::; $short =~ s:[.].*::; # basename for all exts
1762         $short =~ s/name:sitemap://;
1763         $short .=" ~";
1764         site_map_list_title ($F, "$short");
1765         site_map_long_title ($F, "external sitemap index");
1766         site_map_list_date  ($F, &timetoday());
1767         print "'$F' external sitemap index$n";
1768     }
1769 }
1770 sub scan_httpspec
1771 {
1772     # nothing so far
1773 }
1774
1775 sub skip_namespec
1776 {
1777     # nothing so far
1778 }
1779 sub skip_httpspec
1780 {
1781     # nothing so far
1782 }
1783
1784 # ==========================================================================
1785 # and now generate the output pages
1786 #                                                                   2.PASS
1787
1788 sub head_sed_sitemap # $filename $section
1789 {
1790     my ($U,$V,$Z) = @_;
1791     my $FF=&sed_slash_key($U);
1792     my $SECTION=&sed_slash_key($V);
1793     my $SECTS="<!--sect[$NN$AZ]-->" ;
1794     my $SECTN="<!--sect[$NN]-->"; # lines with hrefs
1795     my @OUT = ();
1796     push @OUT, "/^$SECTS.*<a href=\\\"$FF\\\">/ and s|</a>|</a></b>|;";
1797     push @OUT, "/^$SECTS.*<a href=\\\"$FF\\\">/ and s|<a href=|<b><a href=|;";
1798     push @OUT, "/ href=\\\"$SECTION\\\"/ "
1799         ."and s|^<td class=\\\"[^\\\"]*\\\"|<td |;" if $sectiontab ne "no";
1800     return @OUT;
1801 }
1802
1803 sub head_sed_listsection # $filename $section
1804 {
1805    # traditional.... the sitefile is the full navigation bar
1806     my ($U,$V,$Z) = @_;
1807     my $FF=&sed_slash_key($U);
1808     my $SECTION=&sed_slash_key($V);
1809     my $SECTS="<!--sect[$NN$AZ]-->" ;
1810     my $SECTN="<!--sect[$NN]-->"; # lines with hrefs
1811     my @OUT = ();
1812     push @OUT, "/^$SECTS.*<a href=\\\"$FF\\\">/ and s|</a>|</a></b>|;";
1813     push @OUT, "/^$SECTS.*<a href=\\\"$FF\\\">/ and s|<a href=|<b><a href=|;";
1814     push @OUT, "/ href=\\\"$SECTION\\\"/ "
1815         ."and s|^<td class=\\\"[^\\\"]*\\\"|<td |;" if $sectiontab ne "no";
1816     return @OUT;
1817 }
1818
1819 sub head_sed_multisection # $filename $section
1820 {
1821     # sitefile navigation bar is split into sections
1822     my ($U,$V,$Z) = @_;
1823     my $FF=&sed_slash_key($U);
1824     my $SECTION=&sed_slash_key($V);
1825     my $SECTS="<!--sect[$NN$AZ]-->" ;
1826     my $SECTN="<!--sect[$NN]-->"; # lines with hrefs
1827     my @OUT = ();
1828     # grep all pages with a =sect= relation to current $SECTION and
1829     # build foreach an sed line "s|$SECTS\(<a href=$F>\)|<!--sectX-->\1|"
1830     # after that all the (still) numeric SECTNs are deactivated / killed.
1831     for my $section ($SECTION, $headsection, $tailsection) {
1832         next if $section eq "no";
1833         for (grep {/^=sect=[^ ]* $section/} @MK_INFO) {
1834             my $x = $_;
1835             $x =~ s, .*,\\\"\)|<!--sectX-->\$1|,;
1836             $x =~ s,^=sect=,s|^$SECTS\(.*<a href=\\\",;
1837             push @OUT, $x.";";
1838         }
1839     }
1840     push @OUT, "s|^$SECTN\[^ \]*(<a href=[^<>]*>).*|<!-- \$1 -->|;";
1841     push @OUT, "/^$SECTS.*<a href=\\\"$FF\\\">/ and s|</a>|</a></b>|;";
1842     push @OUT, "/^$SECTS.*<a href=\\\"$FF\\\">/ and s|<a href=|<b><a href=|;";
1843     push @OUT, "/ href=\\\"$SECTION\\\"/ "
1844         ."and s|^<td class=\\\"[^\\\"]*\\\"|<td |;" if $sectiontab ne "no";
1845     return @OUT;
1846 }
1847
1848 sub make_sitefile # "$F"
1849 {
1850     $SOURCEFILE=&html_sourcefile($F);
1851  if ($SOURCEFILE ne $F) {
1852  if (-f $SOURCEFILE) {
1853    # remember that in this case "${SITEFILE}l" = "$F" = "${SOURCEFILE}l"
1854    @MK_VARS = &info2vars_sed();           # have <!--title--> vars substituted
1855    @MK_META = &info2meta_sed();           # add <meta name="DC.title"> values
1856    if ( $simplevars eq "warn") {
1857        @MK_TEST = &info2test_sed();       # check <!--title--> vars old-style
1858 ##       $SED_LONGSCRIPT ./$MK_TEST $SOURCEFILE | tee -a ./$MK_OLDS ; fi
1859    }
1860    my @F_HEAD = (); my @F_FOOT = ();
1861    push @F_HEAD, @MK_PUTS;
1862    push @F_HEAD, &head_sed_sitemap ($F, &info_get_entry_section());
1863    push @F_HEAD, "/<head>/ and $sed_add join(\"\\n\", \@MK_META);";
1864    push @F_HEAD, @MK_VARS; push @F_HEAD, @MK_TAGS;
1865    push @F_HEAD, "/<\\/body>/ and next;";                #cut lastline
1866    if ( $sitemaplayout eq "multi") {
1867        push @F_FOOT,  &make_multisitemap();        # here we use ~foot~ to
1868    } else {
1869        push @F_FOOT,  &make_listsitemap();         # hold the main text
1870    }
1871
1872    my $html = ""; #
1873    $html .= &eval_MK_FILE($SITEFILE, @F_HEAD);
1874    $html .= join("", @F_FOOT);
1875    for (source($SITEFILE)) {
1876        /<\/body>/ or next;
1877        $html .= &eval_MK_LIST($_, @MK_VARS);
1878    }
1879   open F, ">$F"; print F $html; close F;
1880   print "'$SOURCEFILE': ",ls_s($SOURCEFILE)," >-> ",ls_s($F),"$n";
1881    savesource("$F.~head~", \@F_HEAD);
1882    savesource("$F.~foot~", \@F_FOOT);
1883 } else {
1884     print "'$SOURCEFILE': does not exist$n";
1885 } }
1886 }
1887
1888 sub make_htmlfile # "$F"
1889 {
1890     $SOURCEFILE=&html_sourcefile($F);                      #     2.PASS
1891  if ("$SOURCEFILE" ne "$F") {
1892  if (-f "$SOURCEFILE") {
1893     if (grep {/<meta name="formatter"/} source($SOURCEFILE)) {
1894       print "$SOURCEFILE: SKIP, this sourcefile looks like a formatted file$n";
1895       print "$SOURCEFILE:  (may be a sourcefile in place of a targetfile?)$n";
1896     return; }
1897     @MK_VARS = &info2vars_sed();           # have <!--title--> vars substituted
1898     @MK_META = &info2meta_sed();           # add <meta name="DC.title"> values
1899     if ( $simplevars eq "warn") {
1900         @MK_TEST = &info2test_sed();       # check <!--title--> vars old-style
1901 ##       $SED_LONGSCRIPT ./$MK_TEST $SOURCEFILE | tee -a ./$MK_OLDS ; fi
1902     }
1903     my @F_HEAD = (); my @F_BODY = (); my $F_FOOT = "";
1904     push @F_HEAD, @MK_PUTS;
1905     if ( $sectionlayout eq "multi") {
1906         push @F_HEAD, &head_sed_multisection ($F, &info_get_entry_section());
1907     } else {
1908         push @F_HEAD, &head_sed_listsection ($F, &info_get_entry_section());
1909     }
1910     push @F_HEAD, @MK_VARS; push @F_HEAD, @MK_TAGS;         #tag and vars
1911     push @F_HEAD, "/<\\/body>/ and next;";                #cut lastline
1912     push @F_HEAD, "/<head>/ and $sed_add join(\"\\n\",\@MK_META);"; #add metatags
1913     push @F_BODY, "/<title>/ and next;";                  #not that line
1914     push @F_BODY, @MK_VARS; push @F_BODY, @MK_TAGS;         #tag and vars
1915     push @F_BODY, &bodymaker_for_sectioninfo();             #if sectioninfo
1916     push @F_BODY, &info2body_sed();                         #cut early
1917     push @F_HEAD, &info2head_sed();
1918     push @F_HEAD, @{$FAST{$F}};
1919     if ($emailfooter ne "no") {
1920         $F_FOOT = &body_for_emailfooter();
1921     }
1922     my $html = "";
1923     $html .= eval_MK_FILE($SITEFILE, @F_HEAD);
1924     $html .= eval_MK_FILE($SOURCEFILE, @F_BODY);
1925     $html .= $F_FOOT;
1926     for (source($SITEFILE)) {
1927         /<\/body>/ or next;
1928         $_ = &eval_MK_LIST($_, @MK_VARS);
1929         $html .= $_;
1930     }
1931     savelist(\@{$INFO{$F}});
1932    open F, ">$F" or die "could not write $F: $!"; print F $html; close F;
1933    print "'$SOURCEFILE': ",&ls_s($SOURCEFILE)," -> ",&ls_s($F),"$n";
1934     savesource("$F.~head~", \@F_HEAD);
1935     savesource("$F.~body~", \@F_BODY);
1936  } else {
1937      print "'$SOURCEFILE': does not exist$n";
1938  }} else {
1939      print "<$F> - skipped$n";
1940  }
1941 }
1942
1943 my $PRINTSITEFILE;
1944 sub make_printerfriendly # "$F"
1945 {                                                                 # PRINTER
1946     my $printsitefile="0";                                        # FRIENDLY
1947     my @F_FAST = (); my $BODY_TXT; my $BODY_SED;
1948     my $P=&html_printerfile ($F);
1949     my @P_HEAD = (); my @P_BODY = ();
1950     if ("$F" =~ /^(${SITEFILE}|${SITEFILE}l)$/) {
1951         @F_FAST = &make_fast ("$F");
1952         $printsitefile=">=>" ; $BODY_TXT="$F.~foot~" ;
1953     } elsif ("$F" =~ /^(.*[.]html)$/) {
1954         $printsitefile="=>" ;  $BODY_TXT="$SOURCEFILE";
1955     }
1956     if (grep {/<meta name="formatter"/} source($BODY_TXT)) { return; }
1957     if ($printsitefile ne "0" and -f $SOURCEFILE) {
1958       @MK_FAST = &make_printerfile_fast (\@FILELIST);
1959       push @P_HEAD, @MK_VARS; push @P_HEAD, @MK_TAGS; push @P_HEAD, @MK_FAST;
1960       @MK_METT = map { my $x = $_; $x =~
1961       /DC.relation.isFormatOf/ and $x =~ s|content=\"[^\"]*\"|content=\"$F\"| ;
1962           $x } @MK_META;
1963       push @P_HEAD, "/<head>/ and $sed_add join(\"\\n\", \@MK_METT);";
1964       push @P_HEAD, "/<\\/body>/ and next;";
1965       push @P_HEAD, &select_in_printsitefile ("$F");
1966       my $_ext_=&print_extension($printerfriendly);
1967       push @P_HEAD, map { my $x=$_; $x =~ s/[.]html\"|/$_ext_$&/g; $x} @F_FAST;
1968 #     my $line_=&sed_slash_key($printsitefile_img_2);
1969       push @P_HEAD, "/\\|\\|topics:/"
1970           ." and s| href=\\\"\\#\\.\\\"| href=\\\"$F\\\"|;";
1971       push @P_HEAD, "/\\|\\|\\|pages:/"
1972           ." and s| href=\\\"\\#\\.\\\"| href=\\\"$F\\\"|;";
1973       push @P_HEAD, @F_FAST;
1974       push @P_BODY, @MK_VARS; push @P_BODY, @MK_TAGS; push @P_BODY, @MK_FAST;
1975       push @P_BODY, map { my $x=$_; $x =~ s/[.]html\"|/$_ext_$&/g; $x} @F_FAST;
1976       push @P_BODY, @F_FAST;
1977       my $html = "";
1978       $html .= eval_MK_FILE($PRINTSITEFILE, @P_HEAD);
1979       $html .= eval_MK_FILE($BODY_TXT, @P_BODY);
1980       for (source($PRINTSITEFILE)) {
1981           /<\/body>/ or next;
1982           $_ = &eval_MK_LIST($_, @MK_VARS);
1983           $html .= $_;
1984       }
1985       open P, ">$P" or die "could not write $P: $!"; print P $html; close P;
1986       print "'$SOURCEFILE': ",ls_s($SOURCEFILE)," $printsitefile ",ls_s($P),"$n";
1987   }
1988 }
1989
1990
1991 # ========================================================================
1992 # ========================================================================
1993 # ========================================================================
1994 # ========================================================================
1995 #                                                          #### 0. INIT
1996 $F=$SITEFILE;
1997 &make_sitemap_init();
1998 &make_sitemap_list();
1999 &make_sitemap_sect();
2000 &make_sitemap_page();
2001 savelist(\@MK_INFO);
2002
2003 @FILELIST=&echo_site_filelist();
2004 if ($o{filelist} or $o{list} eq "file" or $o{list} eq "files") {
2005     for (@FILELIST) { print $_,"$n";  } exit; # --filelist
2006 }
2007 if ($o{files}) { @FILELIST=split(/ /, $o{files}); } # --files
2008 if ($#FILELIST < 0) { print STDERR "nothing to do$n"; }
2009 if ($#FILELIST == 0 and
2010     $FILELIST[0] eq $SITEFILE) { print STDERR "only '$SITEFILE'!?$n"; }
2011
2012 for (@FILELIST) {                                    #### 1. PASS
2013     $F = $_;
2014     if (/^(name:.*)$/) {
2015         &scan_namespec ("$F");
2016     } elsif (/^(http:.*|.*:\/\/.*)$/) {
2017         &scan_httpspec ("$F");
2018     } elsif (/^(${SITEFILE}|${SITEFILE}l)$/) {
2019         &scan_sitefile ("$F") ;;                      # ........... SCAN SITE
2020     } elsif (/^(\.\.\/.*)$/) {
2021         print "!! -> '$F' (skipping topdir build)$n";
2022 # */*.html)
2023 #    make_fast  # try for later subdir build
2024 #    echo "!! -> '$F' (skipping subdir build)"
2025 #    ;;
2026 # */*/*/|*/*/|*/|*/index.htm|*/index.html)
2027 #    echo "!! -> '$F' (skipping subdir index.html)"
2028 #    ;;
2029     } elsif (/^(.*\.html)$/) {
2030         &scan_htmlfile ("$F") ;;                      # ........... SCAN HTML
2031     } elsif (/^(.*\/)$/) {
2032         print "'$F' : directory - skipped$n";
2033         &site_map_list_title ("$F", &sed_slash_key($F));
2034         &site_map_long_title ("$F", "(directory)");
2035     } else {
2036         print "?? -> '$F'$n";
2037     }
2038 }
2039
2040 if ($printerfriendly) {                            # .......... PRINT VERSION
2041     my $_ext_=esc(&print_extension($printerfriendly));
2042     $PRINTSITEFILE=$SITEFILE; $PRINTSITEFILE =~ s/(\.\w*)$/$_ext_$1/;
2043     $F=$PRINTSITEFILE;
2044     my @TEXT = &make_printsitefile();
2045     print "NOTE: going to create printer-friendly sitefile '$PRINTSITEFILE'"
2046         ." $F._$i$n";
2047     savelist(\@TEXT);
2048     my @LINES = map { chomp; $_."$n" } @TEXT;
2049     savesource($PRINTSITEFILE, \@LINES);
2050     if (1) {
2051         if (open PRINTSITEFILE, ">$PRINTSITEFILE") {
2052             print PRINTSITEFILE join("", @LINES); close PRINTSITEFILE;
2053         }
2054     }
2055 }
2056
2057 if ($simplevars eq " ") {
2058     @MK_OLDS = ();
2059 }
2060
2061 for (@FILELIST) {                                          #### 2. PASS
2062   $F = $_;
2063   if (/^(name:.*)$/) {
2064       &skip_namespec ("$F") ;;
2065   } elsif (/^(http:.*|.*:\/\/.*)$/) {
2066       &skip_httpspec ("$F") ;;
2067   } elsif (/^(${SITEFILE}|${SITEFILE}l)$/) {
2068       &make_sitefile ("$F") ;;                         # ........ SITE FILE
2069       &make_printerfriendly ("$F") if ($printerfriendly);
2070   } elsif (/^(\.\.\/.*)$/) {
2071       print "!! -> '$F' (skipping topdir build)$n";
2072 # */*.html)
2073 #   echo "!! -> '$F' (skipping subdir build)"
2074 #   ;;
2075 # */*/*/|*/*/|*/|*/index.htm|*/index.html)
2076 #   echo "!! -> '$F' (skipping subdir index.html)"
2077 #   ;;
2078   } elsif (/^(.*\.html)$/) {
2079       &make_htmlfile ("$F") ;;               # .................. HTML FILES
2080       &make_printerfriendly ("$F") if ($printerfriendly);
2081   } elsif (/^(.*\/)$/) {
2082       print "'$F' : directory - skipped$n";
2083   } else {
2084       print "?? -> '$F'$n";
2085   }
2086 # .............. debug ....................
2087 ##   if test -d DEBUG && test -f "./$F" ; then
2088 ##      cp ./$F.$INFO DEBUG/$F.info.TMP
2089 ##      for P in tags vars meta page date list html sect info ; do
2090 ##      test -f ./$MK.$P.tmp && cp ./$MK.$P.tmp DEBUG/$F.$P.tmp
2091 ##      test -f ./$MK.$P.TMP && cp ./$MK.$P.TMP DEBUG/$F.$P.TMP
2092 ##      done
2093 ##   fi
2094 } # done
2095
2096 if ( $simplevars eq "warn") {
2097     my $oldvars = $#MK_OLDS; $oldvars ++;
2098     if (not $oldvars) {
2099 print "HINT: you have no simplevars in your htm sources, so you may want to$n";
2100 print "hint: set the magic <!--mksite:nosimplevars--> in your $SITEFILE$n";
2101 print "hint: which makes execution _faster_ actually in the 2. pass$n";
2102 print "note: simplevars expansion was the oldstyle way of variable expansion$n";
2103 } else {
2104 print "HINT: there were $oldvars simplevars found in your htm sources.$n";
2105 print "hint: This style of variable expansion will be disabled in the near$n";
2106 print "hint: future. If you do not want change then add the $SITEFILE magic$n";
2107 print "hint: <!--mksite:simplevars--> somewhere to suppress this warning$n";
2108 print "note: simplevars expansion will be an explicit option in the future.$n";
2109 print "note: errornous simplevar detection can be suppressed with a magic$n";
2110 print "note: hint of <!--mksite:nosimplevars--> in the $SITEFILE for now.$n";
2111 } }
2112
2113 ## rm ./$MK.*.tmp
2114 exit 0