SourceForge.net Logo
March 3, 2009
Š GPL
 
ProWikiCenter
Code /
Part2

 

sub RetParam {
  my ($name,$object)=@_;
  my $ret;

  $ret=$FormData{$name};
  if(defined($ret)) {
    goto do_ret;
  }

  $ret=$cgi->param($name);
  if(defined($ret)) {
    goto do_ret;
  }

  $ret=$UserPrefs{$name};
  if(defined($ret)) {
    goto do_ret;
  }

  $ret = $object;

do_ret:

  if($ret =~ m/\$/) {
    $ret =~ s/\{\$PARAM.([^\}]*)\}/{RetParam($1)}/ge;
  }

  return $ret;
}

sub RetParamCrs { # strip cr
  my $ret=RetParam(@_);
  $ret =~ s/\r//g;
  return $ret;
}

sub MsgPrintStr {
  my($s)=@_;
  my($OUT);
  my $MsgFile = "$DataDir/msglog";

  if(!open($OUT,">>$MsgFile")) {
    $lb1=Lu('Logfile error|LogFile-Fehler|Erreur de FichierLog|Error de FicheroLog');
    die "$lb1 (File=$MsgFile): $!";
  }
  $s=ParamsRetStr(@_);
  print $OUT "$s";
  close($OUT);
}

sub MsgPrint {
  my($s)=@_;
  MsgPrintStr("$s\n");
}

sub StrEmpty {
  my ($s)= @_;
  if($s =~ m/[^\s]/) {
     return 0;
  }
  return 1;
}

sub StrExist {
  my ($s)= @_;
  if($s =~ m/[^\s]/) {
     return 1;
  }
  return 0;
}

sub Envelope {
  my ($a,$s,$b)=@_;
  if($s ne '') {
    return $a.$s.$b;
  }
  return '';
}

sub StrDecorate {
  my ($s, $fdec)=@_;
  my $ret = $fdec;
  $ret =~ s/@/$s/ ;
  return $ret;
}

sub FontDec {
  my ($s)=@_;

  if($FontDecSuppress) {
    return $s;
  }
  my $ret = $FormFontDec;
  $ret =~ s/@/$s/ ;
  return $ret;
}

sub Cell1 {
  my ($s)=@_;
  return "<td width='1%' align='right'>" . FontDec($s) . "</td>";
}

sub Cell1Top {
  my ($s)=@_;
  return "<td width='1%' align='right' valign='top'>" . FontDec($s) . "</td>";
}

sub Cell2 {
  my ($s)=@_;
  return "<td width='99%'>" . FontDec($s) . "</td>";
}

sub Cell2Top {
  my ($s)=@_;
  return "<td width='99%' valign='top'>" . FontDec($s) . "</td>";
}

sub Line {
  my ($s1, $s2)=@_;
  return "<tr bgcolor='$FormBcol'>" . Cell1($s1) . Cell2($s2) . "</tr>\n";
}

sub LineVar {
  my $n=int(@_);
  my $ret= "<tr bgcolor='$FormBcol'>";
  my $i;
  for ($i=0; $i<$n; $i++) {
    if($i<$n-1) {
      $ret .= Cell1($_[$i]);
    } else {
      $ret .= Cell2($_[$i]);
    }
  }
  $ret .= "</tr>\n";
  return $ret;
}

sub LineTop {
  my ($s1, $s2)=@_;
  return "<tr bgcolor='$FormBcol'>" . Cell1Top($s1) . Cell2Top($s2) . "</tr>\n";
}

sub LineRm {
  my ($s1)=@_;
  return "<tr bgcolor='$FormBcol'>" . CellRm($s1) . "</tr>\n";
}

sub LineLm {
  my ($s1)=@_;
  return "<tr bgcolor='$FormBcol'>" . CellLm($s1) . "</tr>\n";
}

sub CellRs {
  my ($s)=@_;
  return "<td width='1%' align='right'>" . FontDec($s) . "</td>";
}

sub CellLs {
  my ($s)=@_;
  return "<td width='1%'>" . FontDec($s) . "</td>";
}

sub CellLm {
  my ($s)=@_;
  return "<td width='99%'>" . FontDec($s) . "</td>";
}

sub CellRm {
  my ($s)=@_;
  return "<td width='99%' align='right'>" . FontDec($s) . "</td>";
}

sub HeaderColSpan {
  my ($head,$col,$span)=@_;
  return "<tr bgcolor='$col'><td colspan='$span'>" . FontDec($head) . "</td></tr>\n";
}

sub LineRsLmCol {
  my ($s1,$s2,$col)=@_;
  return "<tr bgcolor='$col'>" . CellRs($s1) . CellLm($s2) . "</tr>\n";
}

sub LineRsLsLmCol {
  my ($s1,$s2,$s3,$col)=@_;
  return "<tr bgcolor='$col'>" . CellRs($s1) . CellLs($s2) . CellLm($s3) . "</tr>\n";
}

sub LineRsLm {
  my ($s1,$s2)=@_;
  return LineRsLmCol($s1,$s2,$FormBcol);
}

sub LineLsLsLmCol {
  my ($s1,$s2,$s3,$col)=@_;
  return "<tr bgcolor='$col'>" . CellLs($s1) . CellLs($s2) . CellLm($s3) . "</tr>\n";
}

sub LineLsLsLm {
  my ($s1,$s2,$s3)=@_;
  return LineLsLsLmCol($s1,$s2,$s3,$FormBcol);
}

sub LineLsRsLmCol {
  my ($s1,$s2,$s3,$col)=@_;
  return "<tr bgcolor='$col'>" . CellLs($s1) . CellRs($s2) . CellLm($s3) . "</tr>\n";
}

sub LineLsRsLm {
  my ($s1,$s2,$s3)=@_;
  return LineLsRsLmCol($s1,$s2,$s3,$FormBcol);
}

sub LineLsRsLsLmCol {
  my ($s1,$s2,$s3,$s4,$col)=@_;
  return "<tr bgcolor='$col'>" . CellLs($s1) . CellRs($s2) . CellLs($s3) . CellLm($s4) . "</tr>\n";
}

sub LineLsRsLsLm {
  my ($s1,$s2,$s3,$s4)=@_;
  return LineLsRsLsLmCol($s1,$s2,$s3,$s4,$FormBcol);
}

sub FormTableStartBcolLcolLinePad {
  my ($bcol,$lcol,$line,$pad)=@_;

  $FormBcol=$bcol;
  return "<table border='0' cellspacing='0' cellpadding='0' bgcolor='$lcol' width='$FormWidth'><tr><td><table border='0' cellspacing='$line' cellpadding='$pad' width='100%'>\n";
}

sub FormTableStart {
  return FormTableStartBcolLcolLinePad($FormTextbackground,$FormLinecolor,$FormLinewidth,$FormPadding);
}

sub FormTableEnd {
  return "</table></td></tr></table>\n";
}

sub FormSelect {
  my ($name,$value,@tab)=@_;
  my $ret="<select name='$name'>\n";
  my ($elm, $sel);

  foreach $elm (@tab) {
    $sel = ($elm eq $value) ? " selected" : "";
    $ret .= "<option$sel value='$elm'>$elm\n";
  }
  $ret .= "</select>";
  return $ret;
}

sub FormSelectHash {
  my ($name,$value,%hash)=@_;
  my $ret="<select name='$name'>\n";
  my ($key, $nam, $sel);

  foreach $key (sort keys(%hash)) {
    $sel = ($key eq $value) ? " selected" : "";
    $nam = $hash{$key};
    $ret .= "<option$sel value='$key'>$nam\n";
  }
  $ret .= "</select>";
  return $ret;
}

sub FormPassword {
  my ($name,$value)=@_;
  return $cgi->password_field(-name=>$name, -value=>$value, -size=>10, -maxlength=>50);
}

sub FormFile {
  my ($name)=@_;
  return $cgi->filefield(-name=>$name, -value=>'', -size=>50, -maxlength=>80);
}

sub FormText {
  my ($name,$value,$size,$hidden)=@_;
  my $maxlen=3*$size;
  if($hidden ne '') {
     return "<input type='hidden' name='$name' value='$value' />";
  }
  return "<input type='text' name='$name' value='$value' size='$size' maxlength='$maxlen' />";
}

sub FormTextParam {
  my ($name,$object,$size)=@_;
  my $value = RetParam($name, $object);
  return FormText("p_$name",$value,$size);
}

sub FormTextArea {
  my ($name,$value,$rows,$cols,$wrap,$wide)=@_;
  my $style;

  if($wrap) {
    $wrap="wrap='virtual'";
  }
  if($wide) {
    if($wide==1) {
      if(RetParam("editwide", 1)) {
        $style=1;
      }
    } else {
      $style=1;
    }
    if($style) {
      $style="style='width:90%'";
    }
  }
  $value=QuoteHtml($value);
  return "<textarea name='$name' rows='$rows' cols='$cols' $wrap $style>$value</textarea>";
}

sub FormCheck {
  my ($name, $checked, $label)=@_;
  my $hcheck;

  if($checked) {
    $hcheck="CHECKED";
  }
  return "<input type='checkbox' name='$name' value='on' $hcheck />$label";
}

sub FormRadio {
  my ($name,$value,$checked,$label)=@_;
  if($checked ne '') {
    $checked='checked';
  }
  return "<input type='radio' name='$name' value='$value' $checked />$label";
}

sub FormCheckParam {
  my ($name, $object, $label)=@_;
  my $checked = (RetParam($name, $object) > 0);
  return FormCheck("p_$name",$checked,$label);
}

sub FormButton {
  my ($name,$label)=@_;
  if($name ne '') {
    $name=" name='$name' ";
  }
  return "<input type='submit' $name value='$label'>";
}

sub InitLinkPatterns {
  my ($LpA,$LpB,$LpF,$LpU,$QDelim,$i);

  $UpperLetter = "A-Z";
  $LowerLetter = "a-z" . $AddLetter;
  $AnyLetter   = "A-Za-z" . $AddLetter;

  if($AddLetter =~ m/[+]/) {
    $PlusAllowed=1;
  }
  if($NonEnglish) {
    if($WikiUnicode) {
      # $UpperLetter .= "..."; (not implemented)
      $LowerLetter .= "\x80-\xff";
      $AnyLetter   .= "\x80-\xff";
    } else {
      $UpperLetter .= "\xc0-\xde";
      $LowerLetter .= "\xdf-\xff";
      $AnyLetter   .= "\xc0-\xff";
    }

    for($i=80; $i<=255; $i++) {
      $NeChrTab{ chr($i) }= sprintf("%c%2x",37,$i);
    }
    $NeChrTab{ chr(43) }= sprintf("%c%2x",37,43);
  }

  if(!$SimpleLinks) {
    $AnyLetter .= "_0-9";
    $LowerLetter .= "_0-9";
  }
  $SepLetter = "[^$AnyLetter]";
  $FreeLetter = "[$AnyLetter- ]";
  $AnyLetterList=$AnyLetter;
  $AnyLetter = "[$AnyLetter]";

  $LowerLetter = "[$LowerLetter]";

  if($WikiUnicode) {
    $UpperLetter = "(?:[$UpperLetter]|\xc3[\x80-\x9e]|\xd0[\x81-\xaf])";
  } else {
    $UpperLetter = "[$UpperLetter]";
  }

  $NoUnderlineLetter=$AnyLetter;
  $NoUnderlineLetter=~s/_//g;

  # link pattern: lowercase between uppercase, then anything
  $LpA = "$UpperLetter+$LowerLetter+$UpperLetter$AnyLetter*";

  # Optional subpage link pattern: uppercase, lowercase, then anything
  $LpB = "$UpperLetter+$LowerLetter+$AnyLetter*";
  if($UnderlineAutoLink) {
    $LpU="$NoUnderlineLetter+_$AnyLetter+";
    $LpA="(?:$LpA|$LpU)";
    $LpB="(?:$LpB|$LpU)";
  }

  if($UseSubpage) { # !!! 1 group
    $WikiPattern = "((?:(?:$LpA|\\/)?(?:\\/$LpB)+)|$LpA)"; # remember: \\=     # $WikiPattern = "((?:(?:$LpA)?\\/)?$LpA)"; # Strict pattern: subpage=WikiPattern
  } else {
    $WikiPattern = "($LpA)";
  }
  $LpF="$FreeLetter+";
  if($FreeLinks) {
    $WikiPattern = "((?:(?:$LpB|\\/)?(?:\\/$LpB)+)|$LpA)"; # remember: \\=     $FreePattern = "((?:(?:$LpF)?(?:\\/$LpF)+)|$LpF)";
  } else {
    $FreePattern = "($LpF)";
  }
  if($WordPattern eq '') {
    $WordPattern="($UpperLetter$LowerLetter+)";
  }
  if($FreeUsernames) {
    $UsernamePattern="$AnyLetter+";
  } else {
    $UsernamePattern=$LpA;
  }
  $QDelim = '("")?';     # Optional quote delimiter (not in output)
  $WikiPatternRef .= $WikiPattern . "(#+$AnyLetter*)?";
  $WikiPattern .= $QDelim;
  $WordPatternRef .= $WordPattern . "(#+$AnyLetter*)?";

  # Url-style links are delimited by one of:
  #   1.  Whitespace (kept in output)
  #   2.  Left angle-bracket (<)  (kept in output)
  #   3.  A single double-quote (")  (kept in output)
  #   4.  A double double-quote ("") (removed from output)

  # Inter-site convention: sites must start with uppercase letter
  # (Uppercase letter avoids confusion with URLs)
  $InterWebNamePattern = $UpperLetter . $AnyLetter . "+";
  $InterWebPattern = "(($InterWebNamePattern:[^\\s\"'<>Š=][^\\s\"'<>Š]+)$QDelim)";
  $UrlProtocols = "(afs|cid|ftp|gopher|http|https|irc|mailto|mid|mms|news|nntp|prospero|telnet|wais)";
  $UrlProtocolsUsingTarget="(http|https)";
  $UrlPattern = "((($UrlProtocols):[^\\s\"<>Š]+)$QDelim)";
  $UploadPattern = "(Upload:([^\\s\"<>Š]+)$QDelim)";
  $ImageExtensions = "(gif|jpg|png|bmp|jpeg|DECLAREIMAGE|IMAGE)";
  $ISBNPattern = "ISBN:?([0-9- xX]{10,})";
  $RFCPattern = "RFC\\s?(\\d+)";
}

sub PageRetDirectory {
  my ($id)=@_;

  if($id =~ /^([a-zA-Z])/) {
    return uc($1);
  }
  return "other";
}

sub WikiRetParamAllStr {
  my ($idval)=@_;
  my ($ret,$var,$val);
  my @plist=$cgi->param();

  foreach $var (@plist) {
    if($ret ne "") {
      $ret .= "&";
    }
    $val=$cgi->param($var);
    if($idval ne '') {
      if($var eq 'id') {
        $val=$idval;
      }
    }
    $ret.="$var=$val";
  }
  return $ret;
}

sub UserHasRight {
  my ($right)=@_;
  if($DefaultRights =~ m/\($right\)/) {
    return 1;
  }
  return $GlobalUserData{"Right[$right]"};
}

sub UserHasStatus {
  my ($need)=@_;
  my ($UserInd,$NeedInd);

  if($need eq "") {
    return 1;
  }
  $NeedInd= StatusRetWeight($need);
  $UserInd= StatusRetWeight($UserStatus);
  if($UserInd>=$NeedInd) {
    return 1;
  }
  return 0;
};

sub ImageRetScript {
  my ($inam)= @_;
  my $ret=  "$inam=new Image(); $inam.src=\"$ButtonBrowserDir/de_$inam.gif\";\n";
  return $ret;
}

sub RetNameRecentChanges {
   return Lu($NameRecentChanges);
}

sub LabelStripBase {
  my($label)=@_;
  if($WikiBase ne '') {
    $label =~ s#^$WikiBase/##;
  }
  return $label;
}

sub PageRetLabel { # deprecated, use LabelCvtVisual
  my($ret)=@_;
  $ret =~ s/_+/ /g;
  return $ret;
}

sub LabelCvtVisual {
  my($ret)=@_;
  $ret =~ s/_+/ /g;
  return $ret;
}

sub TabPushPageExist {
  my($h_dup,$a_tab,$a_new,$pg)=@_;
  my $exist=0;
  my ($p,$id);

  if(PageExist($pg)) {
    if(++$$h_dup{$pg}<=1) {
      push(@$a_tab,$pg); $exist++;
    }
  }

  if($exist==0) {
    if($WordAutoStrip ne '') {
      foreach $p (@WordAutoStripArray) {
        $id=$pg;
        if($id =~ s/$p$//) {
          if(++$$h_dup{$id}<=1) {
            if(PageExist($id)) {
              push(@$a_tab,$id); $exist++;
            }
          }
        }
      }
    }
  }

  if($exist==0) {
    push(@$a_new,$pg);
  }
}

sub PageRetStripArray {
  my($pg)=@_;
  my(@ar,$p,$id);

  push(@ar,$pg);
  if($WordAutoStrip ne '') {
    foreach $p (@WordAutoStripArray) {
      $id=$pg;
      if($id =~ s/$p$//) {
        push(@ar,$id);
      }
    }
  }
  return @ar;
}

sub SisterNetInit {
  my (@ar,$site);
  if($SisterNetInitFlag==0) {
    %SisterNetHash=();
    @ar=ListSplit($SisterNet);
    foreach $site (@ar) {
      if($WikiUnicode==0) {
        StrCvtUnicode($site);
      }
      $SisterNetHash{$site}=1;
    }
    $SisterNetInitFlag=1;
  }
}

sub SiteLeafRetPages {
  my ($site,$pg)=@_;
  my (@pages,$page,@strips,$strip,@stems,$stem);

  @strips=PageRetStripArray($pg);
  foreach $strip (@strips) {
    @stems=PageRetLeafArray($strip,2);
    foreach $stem (@stems) {
      if($stem =~ m/$InterWikiName(:)?(.*)/ ) { # FIXME
        if($2 eq '') {
          $page=$strip;
        } else {
          $page="$2/$strip";
        }
        push(@pages,$page);
      }
    }
  }
  return @pages;
}

sub LeafRetPages {
  return SiteLeafRetPages(InterWikiName(),$_[0]);
}

sub PageRetComplete {
  my ($pg)=@_;
  my ($als,@pages,$node,$site,%sites,$list,@stems,$stem,@strips,$strip,%dup);
  my $id=$pg;

  if($SisterNetInitFlag==0) {
    SisterNetInit();
  }

  @AutoNewPages=();
  if($NewSubpageSyntax) {
    if($id =~ m#^/+#) {
      $id =~ s#^/+#$PageCur/#;
      push(@pages,$id); push(@AutoNewPages,$id);
      goto do_ret;
    }
  } else {
    if($id =~ m#^//#) {
      $id =~ s#^//#$PageCur/#;
      push(@pages,$id); push(@AutoNewPages,$id);
      goto do_ret;
    }
    if($id =~ m#^/#) {
      $id =~ s#^/#$PageTop/#;
      push(@pages,$id); push(@AutoNewPages,$id);
      goto do_ret;
    }
  }
# MsgPrint("PageRetComplete id=$id pg=$pg");
  foreach $als (@AlsTab) {
    $id='';
    if($als eq 'T') {
      $id=$pg;
      TabPushPageExist(\%dup,\@pages,\@AutoNewPages,$id);
    } elsif($als eq 'W') {
      if($WikiBase ne '') {
        $id="$WikiBase/$pg";
        TabPushPageExist(\%dup,\@pages,\@AutoNewPages,$id);
      }
    } elsif($als eq 'B') {
      if($PageParent ne '') {
        $id="$PageParent/$pg";
        TabPushPageExist(\%dup,\@pages,\@AutoNewPages,$id);
      }
    } elsif($als eq 'U') {
      if($PageGran ne '') {
        $id="$PageGran/$pg";
        TabPushPageExist(\%dup,\@pages,\@AutoNewPages,$id);
      }
    } elsif($als eq 'D{categories}') {
      foreach $node (WikiTextRetFolderTab($PageTextWiki,1)) {
        $id="$PageParent/$pg/$node";
        TabPushPageExist(\%dup,\@pages,\@AutoNewPages,$id);
      }
      TabPushPageExist(\%dup,\@pages,\@AutoNewPages,$id);
    } elsif($als eq 'D') {
      $id="$PageCur/$pg";
      TabPushPageExist(\%dup,\@pages,\@AutoNewPages,$id);
    } elsif($als =~ m#^N\{# ) {
      $list=$';
      foreach $node ( split( /[\s,\}]/ ,$list) ) {
        TabPushPageExist(\%dup,\@pages,\@AutoNewPages,"$node/$pg");
      }
    } elsif($als eq 'L') {
      if(!($pg =~ m#/#)) {
        InterWebInit();
        $InterWikiName=InterWikiName();
        @strips=PageRetStripArray($pg);
        foreach $strip (@strips) {
          @stems=PageRetLeafArray($strip);
# MsgPrint("stems=".join(",",@stems));
          foreach $stem (@stems) {
            $stem =~ s/$InterWikiName://;
            $stem.="/$strip";
            if(++$dup{$stem}<=1) {
              push(@pages,$stem);
            }
          }
        }
      }
    } elsif($als eq 'S') {
      $id='';
      %sites=PageRetSisterSitesHash($pg);
      foreach $site (keys %sites) {
        if($SisterNetHash{$site}) {
          if($WikiUnicode==0) {
            UnicodeCvtStr($site);
          }
          push(@pages,"$site:$pg");
        }
      }
    }
    if(($AutoNewStrategies =~ m/^$als/) && ($id ne '')) {
      push(@AutoNewPages,$id);
    }
  }

do_ret:
# MsgPrint("PageRetComplete return=".join(", ",@pages)."  AutoNew: ".join(", ",@AutoNewPages));
  return @pages;
}

sub NoFollow { # sorry, side effect (1)
  $RelTag=" rel='nofollow'";
}

sub UrlNormalizeAmp {
  $_[0] =~ s/&(?!amp;)/&/g;
}

sub UrlLabelClassTitleTargetRetLink { # sorry, side effect (1)
  my ($url,$label,$class,$title,$target)=@_;
  my ($rel);

  if($RtfMode) {
    return "{\\ul\\b $label}";
  }
  if($class ne '') {
    if($class eq 'body') {
      if(($BodyTarget ne '') && ($target ne '_parent')) {
        $target=$BodyTarget;
      }
    }
    $class=" class='$class'";
  }
  if($title ne '') {
    $title=" title='$title'";
  }
  if($target ne '') {
    $target=" target='$target'";
  }
  if($RelTag ne '') {
    $rel=$RelTag;
    $RelTag='';
  }
  UrlNormalizeAmp($url);
  return "<a href='$url'$class$title$target$rel>$label</a>";
}

sub ImageUrlRetHtmlPlus {
  my ($url,$border,$width,$height,$align,$hspace,$style)=@_;

  if($RtfMode) {
    return "{\\ul\\b $url [RTF conversion not implemented]}";
  }
  if($border ne '') {
    $border=" border='$border'";
  }
  if($width ne '') {
    $width=" width='$width'";
  }
  if($height ne '') {
    $height=" height='$height'";
  }
  if($align ne '') {
    $align=" align='$align'";
  }
  if($hspace ne '') {
    $hspace=" hspace='$hspace'";
  }
  if($style ne '') {
    $style=" style='$style'";
  }
  return "<img src='$url'$border$width$height$align$hspace$style>";
}

sub ImageUrlRetHtml {
  my ($url,$style)=@_;
  return ImageUrlRetHtmlPlus($url,'0','','','','',$style);
}

sub NameRetImageUrl {
  my ($name)=@_;
  return "$ImageUrl/$name.gif";
}

sub NameStyleRetImageGif {
  my ($name,$style)=@_;
  return ImageUrlRetHtmlPlus("/image/$name.gif",'0','','','','',$style);
}

sub StrRetNecEsc {
  my ($s)=@_;
  $s  =~ s/([\x80-\xff])/$NeChrTab{$1}/g;
  $s  =~ s/(?<!%5c|%5C|..\\)\x2b/%2B/g;
  return $s;
}

sub StrRetNecHtml {
  my ($s)=@_;
  $s  =~ s/([\x80-\xff])/"&#".ord($1).";"/ge ;
  return $s;
}

sub UrlRetDomain {
  my ($url)=@_;
  my ($dom)=($url =~ m#://([^/]*)# );
  return $dom;
}

sub UrlSetDomain {
  # my ($url,$dom)=@_;
  $_[0] =~ s#://[^/]*#://$_[1]#;
}

sub ScriptRetDomainBase {
  my ($script)=@_;
  my ($dom,$dombase);

  $dom=UrlRetDomain($script);
  if($dom eq '') {
    $dombase=$DomainBase;
  } else {
    $dombase=$Context{"pagename.reduction.$dom"};
  }
  return $dombase;
}

sub ScriptActionRetUrl {
  my ($script,$action)=@_;
  my ($dom,$dombase);
  if($action eq '') {
    return $script;
  }
  if($PagenameReduction) {
    $dombase=ScriptRetDomainBase($script);
# MsgPrint("PagenameReduction=$PagenameReduction dom=$dom dombase=$dombase");
    if($dombase ne '') {   # FIXME: crude method!
      $action =~ s#^$dombase/##;
      $action =~ s#\&id=$dombase/#&id=#;
    }
  }
  return "$script?$action";
}

sub PageRetStemArray {
  my ($id)=@_;
  my (@ar,$stem);
  foreach (split("/",$id)) {
    if($stem ne '') {
      $stem.='/';
    }
    $stem.=$_;
    push(@ar,$stem);
  }
  return @ar;
}

sub UrlCvtDomain {
  my ($url,$newdomain)=@_;
  $url =~ s#^(http.?://)([^/]+)(.*)$#$1$newdomain$3#;
  $_[0]=$url;
}

sub IdStripBase {
  # my ($id,$base)=@_;
  my $base=$_[1];
  if($base eq '*' || $base eq '') {
    return;
  }
  $_[0]=~ s#^$base/##;
}

sub IdRetDomainBase {
  my ($id)=@_;
  my ($domain,$dombase,@stems,$val);

  @stems=PageRetStemArray($id);
  pop(@stems); # not for base page
  unshift(@stems,"*");
  foreach(reverse @stems) {
    $val=$Context{"link.rewrite.$_"};
    if($val ne '') {
      $domain=$val;
      if($PagenameReduction) {
        $dombase=$_;
      } else {
        $dombase='*';
      }
      goto do_ret;
    }
  }
do_ret:
  return ($domain,$dombase);
}

sub RetGate {
  if($DomainGate eq 0) {
    $DomainGate=$CookieID.RandomChrLower().RandomChrLower().RandomChrLower().(100+($^T % 899));
  }
  return $DomainGate;
}

sub RetPageReference {
  my $id;
  if($WikiBase ne '') {
    $id=$WikiBase;
  }
  if($DomainBase ne '') {
    if(length($DomainBase)>=length($id)) {
      $id=$DomainBase."/".RetPageDefault();;
    }
  }
  return $id;
}

sub OptId {
  my $ret;
  my $id=RetPageReference();

  if($id ne '') {
    $ret="&id=$id";
  }
  return $ret;
}

sub RetPageDefault {
  my ($addbase)=@_;
  my $id=LuFirst($Context{"frontpage.for.$DomainBase"},$HomePage,$FrontPage);
# MsgPrint("RetPageDefault id=$id");
  if($addbase) {
    if($DomainBase ne '') {
      if($PagenameReduction==0) {
        $id="$DomainBase/$id";
      }
    }
  }
  return $id;
}

sub RetIdDefault {
  my $id=LuFirst($Context{"frontpage.for.$DomainBase"},$HomePage,$FrontPage);
  my $base=$WikiBase;
  if($base) {
    $id="$base/$id";
  }
  return $id;
}

sub ActionSetVarVal {
  my ($action,$var,$val)=@_;
  if($action eq '') {
    $action = "action=browse&id=".RetPageDefault(1);
  } elsif(!($action =~ m/=/)) {
    $action = "action=browse&id=".$action;
  }
  $action.="&$var=$val";
  $_[0]=$action;
}

sub ScriptCvtIdAction {
  my ($script,$id,$action)=@_;
  my ($newdomain,$dombase)=IdRetDomainBase($id);
  my $needgate=$DomainGateAddAlways;

# MsgPrint("ScriptCvtIdAction script=$script id=$id action=$action");
  if($newdomain ne '') {
    if($newdomain ne $Domain) {
      $script="$DomainUrl$ScriptUrlPath/$script";
      UrlCvtDomain($script,$newdomain);
      $needgate=1;
    }
  }
  if($PagenameReduction) {
    if($dombase ne '') {
      $id =~ s#^$dombase/##;
    }
  }
  if($DomainGateFlag && $needgate) {
    ActionSetVarVal($action,'dgt',RetGate());
  }
  $_[0]=$script;
  $_[1]=$id;
  $_[2]=$action;
# MsgPrint("  => ScriptCvtIdAction script=$script id=$id action=$action");
  return;
}

sub ActionRetId {
  my ($action)=@_;
  my $id;
  if($action =~ m/(?:^|\&|;)id=([^&]*)/) {
    $id=$1;
  } elsif ($action =~ m/=/) {
    $id=RetIdDefault();
  } else {
    $id=$action;
  }
  return $id;
}

sub ScriptActionLabelClassIdTargetTitleRetLink {
  my ($script,$action,$label,$class,$id,$target,$title)=@_;

  if($PlusAllowed) {
    if(!($action=~/=/)) {
      if($action=~/[+]/) {
        $action="action=browse&id=".$action;
      }
    }
  }
  if($NonEnglish) {
    $action=StrRetNecEsc($action);
  }
  if($label eq "Recent Changes") {
    $label=RetNameRecentChanges();
  }
  if($LinkRewrite) {
    if($id eq '') {
      $id=ActionRetId($action);
    }
    ScriptCvtIdAction($script,$id,$action);
  }
  return UrlLabelClassTitleTargetRetLink(ScriptActionRetUrl($script,$action),$label,$class,$title,$target);
}

sub ScriptPageRefLabelClassCompleteRetLink {
  my ($script,$id,$ref,$label,$class,$complete)=@_;
  my (@pages);

  $label=LabelCvtVisual($label);
  if($complete==0) {
    @pages=PageRetComplete($id);
    $id=$pages[0];
  }
  return ScriptActionLabelClassIdTargetTitleRetLink($script,$id.$ref,$label,$class,$id);
}

sub PageLabelClassRetLink {
  my ($id,$label,$class)=@_;
  return ScriptPageRefLabelClassCompleteRetLink($ScriptName,$id,'',$label,$class);
}

sub PageClassRetLink {
  my ($id,$class)=@_;
  return ScriptPageRefLabelClassCompleteRetLink($ScriptName,$id,'',$id,$class);
}

sub PageCompleteRefLabelClassRetLink {
  my ($id,$ref,$label,$class,$trailflag)=@_;
  my ($sn);
  if($trailflag>0 && $TrailPage ne '') {
    if($TrailName ne '') {
      $sn.="&name=$TrailName";
    }
    if($TrailSection ne '') {
      $sn.="&section=$TrailSection";
    }
    return ScriptActionLabelClassIdTargetTitleRetLink($ScriptName,"action=browse&id=$id&trail=$TrailPage$sn",$label,$class,$id);
  }
  return ScriptPageRefLabelClassCompleteRetLink($ScriptName,$id,$ref,$label,$class,1);
}

sub ActionLabelClassIdTargetTitleRetLink {
  my ($action,$label,$class,$id,$target,$title)=@_;
  return ScriptActionLabelClassIdTargetTitleRetLink($ScriptName,$action,$label,$class,$id,$target,$title);
}

sub GetParamTimeSecHost {
  my ($name, $object)=@_;
  my ($fill,$slen);
  my $s=RetParam($name,'');
  if($s eq '') {
    return $object;
  }

  $s =~ s/[_,\.\/\+\:\-]//g;

  $slen=length($s);
  if($name eq 'from') {
    $fill="000000";
  } else {
    $fill="235959";
  }
  if(8<=$slen && $slen<14) {
    $s.=substr($fill,$slen-8,14-$slen);
  }

  my ($y,$mon,$d,$h,$min,$sec) = ( $s =~ m#(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)# );
  if($y eq '') {
    return $object;
  }
  my $ts=TimeAllRetTimeSec($y,$mon,$d,$h,$min,$sec);
  if($ts eq '') {
    return $object;
  }
  $ts -= $TimeZoneOffset;
  return $ts;
}

sub ScriptDiffPageTextClassRetLink {
  my ($script,$diff,$id,$text,$class)=@_;
  return ScriptActionLabelClassIdTargetTitleRetLink($script,"action=browse&diff=$diff&id=$id",$text,$class,$id);
}

sub IdRetEditAction {
  my ($id)=@_;
  my ($action,$vpage);

  if($EditByVisitorPage ne '' && $UserPref eq '') {
    $vpage=Lu($EditByVisitorPage);
    $action="action=browse&id=$vpage&continue=$id";
  } else {
    $action="action=edit&id=$id";
  }
  $action.=OptLang();
  return $action;
}

sub PageLabelClassRetEditLink {
  my ($id,$linkname,$class,$list)=@_;
  my $action=IdRetEditAction($id).$list;

  NoFollow();
  return ActionLabelClassIdTargetTitleRetLink($action,$linkname,$class,$id,'',"edit page $id");
}

sub PageRetFileName {
  my ($id,$ext)=@_;
  return $PageDir. "/". PageRetDirectory($id) . "/$id$ext";
}

sub PageExist {
  my ($id)=@_;
  if($id eq '') {
    return 0;
  }
  if(-f ($PageDir . "/". PageRetDirectory($id) . "/$id.dw")) {
    return 1;
  }
  return 0;
}

sub LogFileGetHash_Type {
  my ($fnam,$h_pidx,$type)=@_;
  my ($line,$work,$op,$key,$val,$IN);

  %$h_pidx=();
  if(!open($IN,"<$fnam")) {
    return;
  }
  local $/ ="\n";
  while($line=<$IN>) {
    if($line =~ m/^(\+|\-|\=)(\S*)\s*(.*)\n/) {
      $work=1; $op=$1; $key=$2; $val=$3;
      if($type) {
        if($type==1) {
          if($InterWeb{$key} eq '') { # filters unknown and leafs
            $work=0;
          }
        } elsif($type==2) {
          if($key =~ m/:/) {
            if($` ne $InterWikiName) {
              $work=0;
            }
          } else { # filters sisters
            $work=0;
          }
# MsgPrint("PLGPI work=$work key=$key val=$val wikiname=$InterWikiName line=$line pre=$`");
        }
      }
      if($work) {
        if(($op eq '+') || ($op eq '=')) {
          $$h_pidx{$key}=$val;
        } elsif ($op eq '-') {
          delete $$h_pidx{$key};
        }
      }
    }
  }
  close($IN);
}

sub WordHashInit {
  if($WordHashInitFlag<1) {
    LogFileGetHash_Type("$DataDir/wordlog",\%WordHash);
    $WordHashInitFlag++;
  }
  if($WordAutoStrip ne '') {
    @WordAutoStripArray=ListSplit($WordAutoStrip);
  }
}

sub WordInit {
  WordHashInit();
}

sub WordExist {
  my ($id)=@_;
  if($WordHashInitFlag<1) {
    WordHashInit();
  }
  if(defined($WordHash{$id})) {
    return 1;
  }
  return 0;
}

sub PageCompleteRefLabelClassRetEditLink {
  my ($id,$ref,$label,$class,$list)=@_;
  my $ret;

  if($RtfMode) {
    return "{\\ul\\i $label}";
  }

  $label=LabelCvtVisual($label);
  if($BeggingUnderline<1) {
    if($label =~ m/ /) {
      $label="{$label}";
    }
  }
  if($BeggingColor ne '') {
    $label=TextFaceSizeColorBoldItalUdlRetHtml($label,'','',$BeggingColor);
    $ret=PageLabelClassRetEditLink($id,$label,$class,$list);
  } else {
    if($BeggingFront) {
      $ret=PageLabelClassRetEditLink($id,"?",$class,$list) . $label;
    } else {
      $ret=$label . PageLabelClassRetEditLink($id,"?",$class,$list);
    }
    if($BeggingUnderline) {
      $ret= "<u>$ret</u>";
    }
  }
  return $ret;
}

sub PageCompleteRefLabelClassRetOptLink {
  my ($id,$ref,$label,$class)=@_;
  if(PageExist($id)) {
    return PageCompleteRefLabelClassRetLink($id,$ref,$label,$class);
  } else {
    return PageCompleteRefLabelClassRetEditLink($id,$ref,$label,$class);
  }
}

sub StrUnicodeCvtUnicode {
  my ($pg,$from,$to)=@_;
  if($from==0) {
    if($to==1) {
      StrCvtUnicode($_[0]);
    }
  } else {
    if($to==0) {
      UnicodeCvtStr($_[0]);
    }
  }
}

sub InterWebSplit {
  my ($script,$unicode,$script2)=split(/\s+/,$_[0],3);
  if($unicode eq '') {
    $unicode=$WikiUnicode;
  }
  return ($script,$unicode,$script2);
}

sub InterWikiRetUrlUnicode {
  my ($site)=@_;
  my ($url,$unicode);

  if($InterWebInitFlag==0) { # perform
    InterWebInit();
  }
  if(defined($InterWeb{$site})) {
    ($url,$unicode)=InterWebSplit($InterWeb{$site});
  } elsif(defined($InterWebSelf{$site})) {
    $url=$InterWebSelf{$site}; $unicode=$WikiUnicode;
  } elsif(defined($Context{"interweb.$site"})) {
    ($url,$unicode)=InterWebSplit($Context{"interweb.$site"});
  }
  return ($url,$unicode);
}

sub InterWikiPageRetUrl {
  my ($iwp)=@_;
  my ($site,$pg,$url,$unicode);

  ($site,$pg)=split(/:/,$iwp,2);
  ($url,$unicode)=InterWikiRetUrlUnicode($site);
  if($url eq '') {
    return "[$iwp]";
  }
  $pg =~ s/&/&/g;  # Unquote common URL HTML
  if($unicode != $WikiUnicode) {
    StrUnicodeCvtUnicode($pg,$WikiUnicode,$unicode);
  }
  $url .= $pg;

  if($NonEnglish) {
     $url= StrRetNecEsc($url);
  }
  return $url;
}

sub UrlInsParts {
  my ($faq,$npm,$pat) = @_;
  my ($n,$m,$h);

  if(($n,$m) = $npm =~ m/$pat/) {
    $faq =~ s/@@/$m/g;
    $faq =~ s/@/$n/g;
  } else {
    $faq =~ s/@/$npm/g;
  }
  return $faq;
}

sub InterWikiPageRetUrlSitePageLabelPunct {
  my ($iwp)=@_;
  my ($name,$punct,$site,$pg,$label,$url,$unicode,$pat);

  ($name,$punct)=SplitUrlPunct($iwp);
  ($site,$pg) = split(/:/,$name,2);

  ($url,$unicode)=InterWikiRetUrlUnicode($site);
  if($url eq '') {
    goto do_return;
  }
  $label=$pg;
  $pg =~ s/&/&/g;  # Unquote common URL HTML
  if($unicode != $WikiUnicode) {
    StrUnicodeCvtUnicode($pg,$WikiUnicode,$unicode);
  }
  if($url =~ m/@/) {
    $pat=First($Context{"interweb.$site.pattern"},'(\d+)\.(\d+)');
    $url=UrlInsParts($url,$pg,$pat);
  } else {
    $url.=$pg;
  }
  if($NonEnglish) {
    $url= StrRetNecEsc($url);
  }
do_return:
  return ($url,$site,$pg,$label,$punct);
}

sub NameIsImage {
  my ($name)=@_;
  return ($name =~ m/\.$ImageExtensions$/i);
}

sub NameIsUrl {
  my ($name)=@_;
  return ($name =~ m/^$UrlPattern$/i);
}

sub InterWikiPageLabelRetLinkSitePagePunct {
  my ($iwp,$label)=@_;
  my ($url,$site,$pg,$label2,$punct)=InterWikiPageRetUrlSitePageLabelPunct($iwp);
  my ($link,$type,$h);

  if($url eq '') {
    goto do_return;
  }
  if(NameIsImage($url)) {
    $link=ImageUrlRetHtml($url);
    goto do_return;
  }
  if($LinkTypeIcons) {
    $h=$Context{"link.type.icon.$site"};
    if($h ne '') {
      $type=$site;
    }
    if($LinkTypeIconRepSite) {
      if($label eq '') {
        if($h ne '-') {
          $label=$pg;
        }
      }
    }
  }
  if($label eq '') {
    StrHexCvtTextSave($label2);
    $label="$site:$label2";
  }
  $link=UrlLabelTypeRetLink($url,$label,$type);

do_return:
  return ($link,$site,$pg,$punct);
}

sub ContextVarRetDefault {
  my ($var,$def)=@_;
  my $ret=$Context{$var};
  if($ret eq '') {
    $ret=$def;
  }
  return $ret;
}

sub ValCheckRange {
  my ($val,$lo,$hi)=@_;
  if(($val<$lo) || ($val>$hi)) {
    return 1;
  }
  return 0;
}

sub ValCheckRangeList {
  my ($val,$range)=@_;
  my ($lo,$hi)=ListSplit($range);
  return ValCheckRange($val,$lo,$hi);
}

sub CheckLinkSuppress {
  my ($id)=@_;
  my $sup=ContextVarRetDefault("link.suppress.$id",'');
  my $bid=PreBase().$id;
  my $ret=0;
  my $self=0;

# MsgPrint("CheckLinkSuppress id=$id PageCur=$PageCur bid=$bid PageLeaf=$PageLeaf");
  if($sup eq '') {
    if(($bid eq $PageCur) || ($id eq $PageLeaf)) {
      $sup=ContextVarRetDefault("link.suppress.self",'');
      $self=1;
    }
  }
  $ret=IsYes($sup);
  if($LinkSuppressFilter ne '') {
    if($id =~ m/$LinkSuppressFilter/) {
      $ret=1;
    }
  }
do_ret:
  return ($ret,$self);
}

sub PageVarRetAutoTalkWiki {
  my($id,$var,$type)=@_;
  my $info=VidaCachePageVarRetVal($id,$var);
  if($info) {
    if(($type==1) && ($PageAutoTalkIcon ne '')) {
      $info="".$info;
    } elsif(($type==2) && ($IndexAutoTalkIcon ne '')) {
      $info="".$info;
    } else {
      $info="...".$info; # must not start with whitespace
    }
  }
  return $info;
}

sub PageVarRetAutoTalk {
  my($id,$var)=@_;
  my $info=PageVarRetAutoTalkWiki($id,$var,1);
  if($info eq '') {
    return '';
  }
  return StoreRaw(TextWikiRetHtml($info));
}

sub PageRefLabelCvtRetAutoTalk {
  my($id,$ref,$label)=@_;
  my($info,$var,$val);
  if($ref=~ m/##(.*)$/) {
    $var=$1;
    $_[2]=~s/##$var$//; # $label
    if($var eq '') {
      $var=$PageAutoTalk;
    }
    if($var eq '') {
      $var="info";
    }
    $info=PageVarRetAutoTalk($id,$var);
  }
  return $info;
}

sub PageRefLabelStoreLink {
  my ($pg,$ref,$label,$explicit,$editflag,$supflag,$sep,$explicit_label)=@_;
  my ($sup,$self,$list,$idshow,$bid,@pages,$name,$ret,$info);
  my $id=$pg;

  if($explicit_label==0) {
    if($sep ne '') {
      if($sep eq $LinkSuppressCharacter) {
        $sep='';
        goto do_not_link;
      }
    }
    if($PageLabelReduction) {
      StrStripStem($label);
    }
  }

  $id =~ s/ /$SpaceReplacement/g;
  $idshow=$id;

  if($supflag) {
    ($sup,$self)=CheckLinkSuppress($id);
    if($sup) {
      if($self) {
        $label=~ s/$SpaceReplacement/ /g;
        $ret=StoreRaw("<strong>$label</strong>");
        goto do_ret;
      }
      $ret=StoreRaw($label);
      goto do_ret;
    }
  }

  $name=$id;
  @pages=PageRetComplete($id);
  $id=$pages[0];
  if($id =~ m/:/) { # we know sister exists
    if($NearLinking) {
      my $sister=$`;
      my $pg=$';
      my ($url,$site,$pg2,$label2,$punct)=InterWikiPageRetUrlSitePageLabelPunct($id);
      $ret=UrlLabelClassTitleTargetRetLink($url,$label2,"body near");
    }
  } elsif(PageExist($id)) {
    if($TrailPage ne '') {
      $ret=StoreRaw(PageCompleteRefLabelClassRetLink($id,$ref,$label,"body",1));
      goto do_ret;
    }
    if($VidaCaching) {
      $info=PageRefLabelCvtRetAutoTalk($id,$ref,$label);
    }
    $ret=PageCompleteRefLabelClassRetLink($id,$ref,$label,"body",0);
  }
  if($ret ne '') {
    if($MultiLinking && $#pages) {
      $ret.=ActionLabelClassIdTargetTitleRetLink("action=multilink&id=$PageCur&link=$name",Symbol('icon_multi.gif',16),"body",$id,'','multilink');
    }
    $ret=StoreRaw($ret);
    goto do_ret;
  }
  if($editflag && $WikiAutoEditLink) {
    if($pg =~ m#\/#) {
      if(StrExist($sep)) {
        if($sep ne "*" && $sep ne ':') {
          $ret=StoreRaw($idshow);
          goto do_ret;
        }
      }
    }
    if($pg =~ m#(^$WordPattern)\/#) {
      if(!PageExist($1)) { # avoid Client/Server?
        $ret=StoreRaw($idshow);
        goto do_ret;
      }
    }
    $list='';
    if(($AutoNewSelect ne '') && ($#AutoNewPages>0)) {
      $list="&list=".join("|",@AutoNewPages);
    }
    $ret=StoreRaw(PageCompleteRefLabelClassRetEditLink($AutoNewPages[0],$ref,$label,"body",$list));
    goto do_ret;
  }

do_not_link:
  $ret=$pg.$ref;

do_ret:
  return $sep.$ret.$info;
}

sub WordRefLabelStoreLink {
  my ($word,$ref,$label,$explicit,$editflag,$trailflag,$sep,$explicit_label)=@_;
  my ($p,$sup,$self,@words,@pages,$pg,$ret,$info);
  my $id=$word;

  if($explicit_label==0) {
    if($sep ne '') {
      if($sep eq $LinkSuppressCharacter) {
        $sep='';
        goto do_not_link;
      }
    }
  }

  ($sup,$self)=CheckLinkSuppress($id);
  if($sup) {
    if($self) {
      $label=~ s/$SpaceReplacement/ /g;
      $ret=StoreRaw("<strong>$label</strong>");
      goto do_ret;
    }
    $ret=StoreRaw($label);
    goto do_ret;
  }

#  MsgPrint("WRSL id=$id");

  if($WordAutoLower) {
    $id=StrRetLower($id);
  }

  @pages=PageRetComplete($id);
  $id=$pages[0];
  if($id ne '') {
    if($id =~ m/:/) { # we know sister exists
      if($NearLinkingWords) {
        my $sister=$`;
        my $pg=$';
        my ($url,$site,$pg2,$label2,$punct)=InterWikiPageRetUrlSitePageLabelPunct($id);
        $ret=UrlLabelClassTitleTargetRetLink($url,$label2,"body near");
      }
    } else {
      if($VidaCaching) {
        $info=PageRefLabelCvtRetAutoTalk($id,$ref,$label);
      }
      $ret=PageCompleteRefLabelClassRetLink($id,$ref,$label,"body",$trailflag);
    }
    if($ret ne '') {
      if($MultiLinking && $#pages) {
        $ret.=ActionLabelClassIdTargetTitleRetLink("action=multilink&id=$PageCur&link=$word",Symbol('icon_multi.gif',16),"body",$id,'','multilink');
      }
      $ret=StoreRaw($ret);
      goto do_ret;
    }
  }

do_not_link:
  $ret=$word.$ref;
do_ret:
  return $sep.$ret.$info;
}

sub PageRetTop { # empty when page is not a subpage
  my ($id)=@_;
  if($id =~ m#/#) {
    $id =~ s|/.*||;
  } else {
    $id='';
  }
  return $id;
}

sub PageRetGrandParent { # empty when page is not a subpage
  my ($id)=@_;
  my @nodes=split(/\//,$id);

  pop(@nodes);
  my $parent=join("/",@nodes);

  pop(@nodes);
  my $gran=join("/",@nodes);
  return ($gran,$parent);
}

sub PageRetStem {
  $_[0] =~ m#^(.*/)#;
  return $1;
}

sub PageRetLeaf { # always exists
  my ($id)=@_;
  my @ar=split(/\//,$id);
  return pop(@ar);
}

sub PageRetTopSub {
  my ($id)=@_;
  if($id =~ m#/#) {
    return split(/\//,$id);
  } else {
    return ('',$id);
  }
}

sub PageTitleClassRetBackLink {
  my ($id,$title,$class,$allowstem)=@_;
  my $name = $id;
  my ($ret,@ar,@ar0,$mp,$page,$i);

  $mp=PageRetTop($id);
  if($mp ne '') {
    $mp = "&mp=$mp";
  }

#  $id =~ s|.+/|/|;  # Subpage match: search for just /SubName
  $id =~ s|.+/+||;  # FIXME: quick hack

  if($id eq "") {
    return $title;
  }
  if($title ne "") {
    $name=$title;
  }
  @ar0=@ar=split(/\//,$name);
  foreach (@ar) {
    if(ContextVarRetDefault("layout.pagetitle.insertblanks.$_",'yes') eq 'yes') {
      $_ =~ s/($LowerLetter)($UpperLetter)/$1 $2/g;
      $_ =~ s/[+] /+/g;
    }
    $_ =~ s/_+/ /g;
  }
  $name=join(" / ",@ar);

  if($ShowSeparatePageTitleStem && ((int(@ar)>1) && $allowstem)) {
    $name=pop(@ar);
    $ret.="<span class='titlestem'>";
    $page.=$WikiBase;
    for($i=0; $i<=$#ar; $i++) {
      StrExistApp($page,"/");
      $page.=$ar0[$i];
      $ret.=ActionLabelClassIdTargetTitleRetLink($page,$ar[$i],'',$page). " / ";
    }
    $ret.="</span>".$br;
  }
  $name =~ s/_+/ /g;
  NoFollow();
  $ret.=ActionLabelClassIdTargetTitleRetLink("search=$id&title=off&word=on&case=on&bl=on$mp",$name,$class,$id);
  return $ret;
}

sub PageLabelClassRetPrefsLink {
  my ($id,$label,$class)=@_;
  my $action="action=editprefs".OptLang();
  if($id eq '') {
    $id=$FormEditId;
  }
  if($id eq '') {
    $id=RetPageReference();
  }
  if($id ne '') {
    $action.="&oldid=$id&id=$id";
  }
  return ActionLabelClassIdTargetTitleRetLink($action,$label,$class,$id,'','edit user preferences');
}

sub PageClassRetPrefsLink {
  my ($id,$class)=@_;
  return PageLabelClassRetPrefsLink($id,Lu($LabelPrefs),$class);
}

sub IdTimestampRetAddFunc {
  my ($id,$timestamp)=@_;
  my ($ret,$pgx,$zf,$super,$cvt);
  my $sep=$LinkBarSep;
  my $pgflag=($id ne '');

  if(UserHasStatus($NeedStatusAdmin)) {
    $super=UserHasStatus($NeedStatusSuper);
    if(PageRetGroupSize($PageTop)>1) {
      $pgx=1;
    }
  }
  if(($TrustedFlag>0)) {
    if($PageIsSmallFlag && $pgflag) {
      $lb1=Lu('Delete page|Seite löschen|EffacezMoi|Quitar página');
      $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("action=delete&id=$id",$lb1,"nav",$id,'','delete page');
    }
    if(!($WikiParams =~ m/action=form/)) { # $WikiParams field contents unsuitable for url
      my $act2=$WikiParams;
      $act2 =~ s/keywords=/action=browse&id=/;
      NoFollow();
      $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("$act2&template=p",Lu($LabelPrint),"nav",'','print');
    }
    if($pgflag && $ShowRTF) {
      if($super || ContextVarRetDefault('feature.rtf',0)) {
        $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("action=rtf&id=$id","RTF","nav",$id,'','RTF');
      }
    }
    if($ShowLinksFunction) {
      if(!($WikiParams =~ m/action=form/)) {
        my $act2=$WikiParams;
        $act2 =~ s/keywords=/action=browse&id=/;
        $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("$act2&menu=1",LiLinks(),"nav",'','_parent');
      }
    }
  }
  if($TrustedFlag && $pgflag) {
    if(($FlagSpellCheck>0) && ($LinkBarSpellCheck==0)) {
      $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("action=rsk&id=$id",Lu($LabelSpellCheck),"nav",$id,'','spellcheck');
    }
    if($FlagArchive && $pgflag) {
      $lb1=Lu('Archive|Archiv|Archive|Archivo');
      $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("action=archive&cmd=list&id=$id",$lb1,"nav",$id,'','archive');
    }
    if($ShowUploadLite && $pgflag) {
      $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("action=upload&id_target=$id",LiUpload(),"nav",$id,'','upload');
    }
  }
  if($pgx && $pgflag) {
    $lb1=Lu('Group|Gruppe|Groupe|Grupo');
    $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("action=indexg&group=$PageTop",$lb1,"nav",$id,'','group');
  }
  if(($cvt=$Context{'function.publish.cvt'}) ne '') {
    my $showit=1;
    my $label=LiPublish();
    my $targetpage=PageRetPublishPage($id);

    if($id eq '') {
      $showit=0; $label.=" ERROR Context"; # FIXME translate
    } elsif(PageRetTextFast($id) eq PageRetTextFast($targetpage)) { # FIXME: performance PageCurRetText()
      $showit=0;
    } elsif(PageRetTime($id)<=PageRetTime($targetpage)) {
      $showit=0;
    }
    if($Context{'function.publish.suppress'} ne '') {
      $showit=0;
    }
    if($showit) {
      $zf .= $sep . ActionLabelClassIdTargetTitleRetLink("action=publish&id=$id&target=$targetpage",$label,"nav",$id);
    } else {
      $zf .= $sep."(".$label.")";
    }
  }

do_exit:
  if($zf ne '') {
    StrStripStrFront($zf,$sep);
    $ret .= LiAdditionalFunctions().LiColon()." $zf";
  }
  return $ret;
}


sub IdTimestampRetEditBar {
  my ($id,$timestamp)=@_;
  my ($ret,$pprop,$pgx,$zf,$super);
  my $sep="   ";

  $ret .= PageLabelClassRetEditLink($id,Lu('Edit text of this page|Text dieser Seite ändern|Editer le texte de cette page|Editar el texto de esta página'),"nav");

  if($timestamp eq $TsCreatePage) {
    $ret .= Lu(' (this is a new page)| (dies ist eine neue Seite)| (ceci est une nouvelle page)| (esto es una nueva página)');
  } elsif($timestamp ne '') {
    $lb1=Lu('date of last change:|zuletzt geändert am|date de la derničre modification|fecha de la modificación más reciente:');
    NoFollow();
    $ret.=" ($lb1 ".TimeRetText($timestamp)." ".ScriptDiffPageTextClassRetLink($ScriptName,4,$id,"(diff)","nav").")";
  }
  return $ret;
}

sub OptLang {
  my $ret;
  if($WikiLanguage>0) {
    $ret="&lang=$WikiLanguage";
  }
  return $ret;
}

sub PreBase {
  my $ret;
  if($WikiBase ne '') {
    $ret = "$WikiBase/";
  }
  return $ret;
}

sub IdSepRetLinkBar {
  my ($id,$sep,$gsep,$eflag,$ver)=@_;
  my ($main,$bar,$zf,@nodes,$node,$st,$action,$sub,$lbp,$page,$label,$hp,$prepend_lbp);
  my $super=UserHasStatus($NeedStatusSuper);
  my $hrflag=0;

  if($LinkBarProjects ne '') {
    foreach (ListSplit($LinkBarProjects)) {
      if($_ eq '-') {
        $lbp.=$sep; $hrflag=0;
      } elsif ($_ eq '----') {
        $lbp.='<hr>'; $hrflag=1;
      } else {
        if($lbp ne '' && $hrflag==0) {
          $lbp.=$sep;
        }
        $hrflag=0;
        ($page,$label)=split(/\|/,$_,2);
        if($label eq '') {
          $label=$page;
        }
        $lbp.=ActionLabelClassIdTargetTitleRetLink($page,Lu($label),"nav",$page);
      }
    }
    $lbp.=$br;
    if(($ver<1) && ($LinkBarCount==0)) {
      $prepend_lbp=1;
      $LinkBarCount++;
    }
  }

  if($FlagFrontPage) {
    StrExistApp($bar,$sep);
    $hp=LuFirst($HomePage,$FrontPage);
    $bar.=ActionLabelClassIdTargetTitleRetLink($hp,LuFirst($LabelFrontPage,$HomePage,$FrontPage),"nav",$hp,'','front page');
  }

  if($id =~ m#/#) {
    if($ShowSeparatePageTitleStem==0) {
      @nodes=split(/\//,$id);
      pop(@nodes);
      StrExistApp($bar,$sep);
      foreach $node (@nodes) {
        $main .= $node;
        $bar .= ActionLabelClassIdTargetTitleRetLink($main,PageRetLabel($node)."/","nav",$main).' ';
        $main .= '/';
        $sub++;
      }
    }
  }
  if($sub) {
    $bar.=$gsep;
  }

  if($FlagRecentChanges) {
    StrExistApp($bar,$sep);
    $hp=PreBase()."RecentChanges";
    $bar.=ActionLabelClassIdTargetTitleRetLink("action=browse&id=$hp".OptLang(),RetNameRecentChanges(),"nav",$hp,'','recent changes');
    if($FlagTestPage) {
      StrExistApp($bar,$sep);
      $hp=PreBase().LuFirst($NameTestSeite,$PageTestPage);
      $bar.=ActionLabelClassIdTargetTitleRetLink($hp,LuFirst($NameTestSeite,$LabelTestPage),"nav",$hp,'','sand box');
    }
  }
  if($FlagForum) {
    StrExistApp($bar,$sep);
    $hp=PreBase().Lu($NameForum);
    $bar.=ActionLabelClassIdTargetTitleRetLink($hp,Lu($LabelForum),"nav",$hp,'',En($LabelForum));
  }
  $bar.=$gsep;
  if($FlagSearch) {
    StrExistApp($bar,$sep);
    $hp=PreBase().Lu($NameSearch);
    $bar.=ActionLabelClassIdTargetTitleRetLink($hp,Lu($LabelSearch),"nav",$hp,'',En($LabelSearch));
  }
  if($FlagMembers) {
    StrExistApp($bar,$sep);
    $hp=PreBase().LuFirst($SearchTextMembers,$PageMembers);
    $bar.=ActionLabelClassIdTargetTitleRetLink($hp,Lu($LabelMembers),"nav",$hp,'',En($LabelMembers));
  }
  if($FlagProjects) {
    StrExistApp($bar,$sep);
    $hp=PreBase().LuFirst($SearchTextProjects,$PageProjects);
    $bar.=ActionLabelClassIdTargetTitleRetLink($hp,Lu($LabelProjects),"nav",$hp,'',En($LabelProjects));
  }
  if($ver && $lbp ne '') {
    StrExistApp($bar,$sep);
    $bar.=$lbp.$gsep;
  }

  if($FlagFolders) {
    StrExistApp($bar,$sep);
    $hp=PreBase().LuFirst($SearchTextFolders,$PageFolders);
    $bar.=ActionLabelClassIdTargetTitleRetLink($hp,Lu($LabelFolders),"nav",$hp,'',En($LabelFolders));
  }
  if($FlagIndex) {
    StrExistApp($bar,$sep);
    $action=($UsePx) ? "action=spx" : "action=index";
    $action.=OptLang().OptId();
    $bar.=ActionLabelClassIdTargetTitleRetLink($action,LuFirst($NameIndex,$LabelIndex),"nav",$WikiBase,'','Index');
  }
  if($FlagHelp) {
    StrExistApp($bar,$sep);
    $hp=PreBase().Lu($NameHelp);
    $bar.=ActionLabelClassIdTargetTitleRetLink($hp,Lu($LabelHelp),"nav",$hp,'',En($LabelHelp));
  }
  $bar.=$gsep;
  if($TrustedFlag>0) {
    if($id ne '') {
      if(($FlagSpellCheck>0) && ($LinkBarSpellCheck>0)) {
        StrExistApp($bar,$sep);
        $bar.=ActionLabelClassIdTargetTitleRetLink("action=rsk&id=$id",Lu($LabelSpellCheck),"nav",$id,'',En($LabelSpellCheck));
      }
      if($FlagArchive && $ver) {
        StrExistApp($bar,$sep);
        $lb1=Lu($LabelArchive);
        $bar.=ActionLabelClassIdTargetTitleRetLink("action=archive&cmd=list&id=$id",$lb1,"nav",$id,'',En($LabelArchive));
      }
      if($FlagDiff) {
        StrExistApp($bar,$sep);
        $bar.=ActionLabelClassIdTargetTitleRetLink("action=browse&diff=4&id=$id",Lu($LabelDiff),"nav",$id,'',En($LabelDiff));
      }
      if($ShowUploadLite && $ver) {
        StrExistApp($bar,$sep);
        $bar.=ActionLabelClassIdTargetTitleRetLink("action=upload&id_target=$id",LiUpload(),"nav",'','','upload');
      }
      if($ShowRTF && $ver) {
        NoFollow();
        StrExistApp($bar,$sep);
        $bar.=ActionLabelClassIdTargetTitleRetLink("action=browse&template=p&id=$id",Lu($LabelPrint),"nav",$id,'','print');
        if($super || ContextVarRetDefault('feature.rtf',0)) {
          StrExistApp($bar,$sep);
          $bar.=ActionLabelClassIdTargetTitleRetLink("action=rtf&id=$id","RTF","nav",$id,'','RTF');
        }
      }
    }
    if($ver && $ShowLinksFunction) {
      if(!($WikiParams =~ m/action=form/)) {
        my $act2=$WikiParams;
        $act2 =~ s/keywords=/action=browse&id=/;
        StrExistApp($bar,$sep);
        $bar.=ActionLabelClassIdTargetTitleRetLink("$act2&menu=1","Links","nav",'','_parent');
      }
    }
  }
  if($FlagPrefs) {
    StrExistApp($bar,$sep);
    $bar.=PageClassRetPrefsLink($id,"nav");
  }
  if(($TrustedFlag>0) && $PageIsSmallFlag && $eflag && $ver) {
    $bar.=$gsep;
    StrExistApp($bar,$sep);
    $lb1=Lu('Delete page|Seite löschen|EffacezMoi|Quitar página');
    $bar.=ActionLabelClassIdTargetTitleRetLink("action=delete&id=$id",$lb1,"nav",$id,'','delete page');
  }
  $bar.=$gsep;
  if($eflag) {
    if($FlagEdit) {
      StrExistApp($bar,$sep);
      $bar.=PageLabelClassRetEditLink($id,LiEdit(),"nav edit");
    }
  }
  $bar.=$br;
  if($prepend_lbp) {
    $bar=$lbp.$bar;
  }
  return $bar;
}

sub IdRetLinkBarHor {
  my ($id,$eflag)=@_;
  return IdSepRetLinkBar($id,$LinkBarSep,'',$eflag,0);
}

sub IdRetLinkBarVer {
  my ($id,$eflag)=@_;
  return IdSepRetLinkBar($id,$br,$br,$eflag,1);
}