SourceForge.net Logo
March 3, 2009
© GPL
 
ProWikiCenter
Code /
Part4

 
Difference (last change) (no other diffs, normal page display)

Changed: 1c1,2018
Describe the new page here.
[[code]


sub FolderRetPagesGetPinfo {
my ($cat,$h pinfo)=@_;
my ($page,@pages,$cats,$leaf,$cat2);
my $showcount=($cat eq LuFirst($SearchTextFolders,$PageFolders)) ? 1 : 0;

%$h pinfo=();
StrCvtNoRegex($cat);

PageIndexInit();
LOOP:
foreach $page (keys %PageIndex) {
$leaf=PageRetLeaf($page);
if($leaf eq $ContextPageName) {
next LOOP;
}
if($WikiBase ne '') {
if(!($page =~ m#^$WikiBase/# )) {
next LOOP;
}
}
$cats=$PageIndex{$page};
if($cats =~ m/(^|\W)$cat(\W|$)/) {
push(@pages,$page);
}
if($showcount) {
foreach $cat2 (split(' ',$cats)) {
if($WikiBase ne '') {
$cat2="$WikiBase/$cat2";
}
$$h pinfo{$cat2}++;
}
}
}
@pages=ArraySort(@pages);
if($showcount) {
foreach $page (@pages) {
$$h pinfo{$page}=" ($$h pinfo{$page})";
}
}
return @pages;
}

sub CategoriesRetPagesGetPinfoCount {
my ($h car,$h pinfo,$h count)=@_;
my ($page,@pages,$cats,$leaf,$cat2,$found,$cat);
my @car=@$h car;

foreach (@car) {
StrCvtNoRegex($_);
}

PageIndexInit();
LOOP:
foreach $page (keys %PageIndex) {
$leaf=PageRetLeaf($page);
if($leaf eq $ContextPageName) {
next LOOP;
}
if($WikiBase ne '') {
if(!($page =~ m#^$WikiBase/# )) {
next LOOP;
}
}
$cats=$PageIndex{$page};
$found=0;
foreach $cat2 (split(' ',$cats)) {
foreach $cat (@car) {
if($cat eq $cat2) {
$found++;
$$h pinfo{$page}=join(' ',$$h pinfo{$page},$cat);
$$h count{$cat}++;
}
}
}
if($found) {
push(@pages,$page);
}
}
@pages=ArraySort(@pages);
return @pages;
}

sub SiteAnzRetSeiten {
my ($site,$anz,$found)=@_;
my $ret;

if($found ne '') {
if($anz == 0) {
$lb1=Lu('No page found|Keine Seite gefunden|Pas de page trouvées|No hay página encontrados');
} elsif($anz==1) {
$lb1=Lu('1 page found|1 Seite gefunden|1 page trouvées|1 página encontrados');
} else {
$lb1=Lu('%COUNT% pages found|%COUNT% Seiten gefunden|%COUNT% pages trouvées|%COUNT% páginas encontrados');
MessRepVar($lb1,"%COUNT%",$anz);
}
} else {
if($anz == 0) {
$lb1=Lu('No page|Keine Seite|Pas de page|No hay página');
} elsif($anz==1) {
$lb1=Lu('1 page|1 Seite|1 page|1 página');
} else {
$lb1=Lu('%COUNT% pages|%COUNT% Seiten|%COUNT% pages|%COUNT% páginas');
MessRepVar($lb1,"%COUNT%",$anz);
}
}
$ret=$lb1;
if($site ne '') {
$lb2=Lu('in %WIKINAME%|im %WIKINAME%|dans %WIKINAME%|en %WIKINAME%');
MessRepVar($lb2,"%WIKINAME%",$site);
$ret.= "$lb2";
}
if($anz==0) {
$ret.='.';
} else {
$ret.=':';
}
return $ret;
}

sub StrCountRetStr {
my ($s,$count)=@_;
my $ret;
if($count>0) {
$ret=$s x $count;
}
return $ret;
}

sub StrRetChrFirst {
my $c=substr($_[0],0,1);
if($WikiUnicode) {
if(ord($c)>127) {
$c=substr($_[0],0,2);
}
}
return $c;
}

sub PageListRetHtml {
my ($site,$script,$a pages,$h pinfo,$gef,$noindent,$notitle,$layout,$anzshow,$h order,$rev,$showheader0,$h label,$h link,$index)=@_;
my ($head,$ret,$label,$pagename,$count,$anz,$title,$body,$pars,$line,$c0,$c1,$hcount,$info);
my ($editcolumn,$align);
my $showheader=RetParam('header',$showheader0);
my $pre=PreBase();
my (%hlink,%hpre,%hlabel);
my $bullets=($layout eq '*') ? 1 : 0;
my @pages=@$a pages;

if(defined($h label)) {
%hlabel=%$h label;
} else {
foreach $pagename (@pages) {
$label=$pagename;
if($WikiBase ne '') {
if($pagename =~ m#^$WikiBase/#) {
$label =~ s#^$WikiBase/##;
} else {
next;
}
}
if($noindent<1) {
if($label =~ m|/|) {
$count = ($label =~ tr#/##);
$hpre{$pagename} = StrCountRetStr("... ",$count);
}
}
if($site ne '') {
$label="$site:$label";
}
$label =~ s/_+/ /g;
$hlabel{$pagename}=$label;
}
}
if(defined($h link)) {
%hlink=%$h link;
} else {
foreach $pagename (@pages) {
$hlink{$pagename}=ScriptPageRefLabelClassCompleteRetLink($script,$pagename,'',$hlabel{$pagename},"body",1);
}
}

if(defined($h order)) {
@pages=HashRetTabSortedStr($h order,$rev);
}

$anz=int(@pages);
$title=SiteAnzRetSeiten($site,$anz,$gef);

if($anzshow>0 && $anzshow<$anz) {
$title=$anzshow . Lu(" of | von | de | de ") . $title;
splice(@pages,$anzshow,int(@pages))
}
if(StrEquList($layout,'Tabelle','table')) {
$align="l";
$pars="[separator=;][titlebackground=lightgreen][linecolor=white][linewidth=2][distance=20]";
if(defined($h pinfo)) {
$title.= ";" . Lu("date of last change|<n>Datum der letzten Änderung</n>|date de la dernière modification|fecha de la modificación más reciente");
$align.="c";
if($$h pinfo{"column.edit"}) {
$title.= "; ".LiEdit();
$editcolumn=1;
$align.="c";
}
}
foreach $pagename (@pages) {
$line=$hpre{$pagename} . "$hlabel{$pagename}";
if(defined($h pinfo)) {
$line .= ";".$$h pinfo{$pagename};
if($editcolumn) {
$line.= "; ".$$h pinfo{"edit.$pagename"};
}
}
$body.=$line.$br;
}
$ret=TextWikiRetHtmlBasic("[[Tabelle][align=$align]$pars$title\n$body]");
} else {
if($notitle<1) {
$head="<h2>$title</h2>\n";
}
foreach $pagename (@pages) {
$line=$hpre{$pagename}.$hlink{$pagename}.$$h pinfo{$pagename};
if($showheader) {
$c1=StrRetChrFirst($hlabel{$pagename});
if($c1 ne $c0) {
$body.="<h4>$c1</h4>\n";
$hcount=0;
}
}
if($bullets && $hcount==0) {
$body.="<ul>\n";
}
if($index) {
if($VidaCaching && ($IndexAutoTalk ne '')) {
$info=PageVarRetAutoTalkWiki($pagename,$IndexAutoTalk,2);
if($info ne '') {
$info=TextWikiRetHtml($info);
}
}
}
if($bullets) {
$body.="<li>$line.$info</li>\n";
} else {
$body.=$line.$info.$br;
}
$hcount++;
$c0=$c1;
}
if($bullets && $hcount) {
$body.="</ul>";
}
$ret=$head.$body.$br;
}
return $ret;
}

sub StoreBracketUrl {
my ($url,$name)=@_;
my ($index,$link,$hidden,$target);

$name=~ s#^ Upload:#$UploadUrl/#;
if($name ne '') {
if(NameIsUrl($name) && NameIsImage($name)) {
if($AutoExtLinkEmptyTarget) {
$target="target=\"_blank\"";
}
$name =~ s/\.(DECLARE)?IMAGE$//;
return StoreRaw("<a href='$url' $target style='background-color: white; border-bottom:solid 0px white;'><img src='$name' border='0'></a>");
} else {
if($ShowHiddenLinks) {
$hidden=" ($url)";
}
}
return StoreRaw(UrlLabelTypeRetLink($url,$name).$hidden);
}

$index=GetBracketUrlIndex($url);
if($NonEnglish) {
$url=StrRetNecEsc($url);
}
$link=UrlLabelTargetTypeRetLink($url,"[$index]",'','-');
return StoreRaw($link);
}

sub InterWikiPageRetLink {
my ($id)=@_;
my ($link,$site,$pg,$punct)=InterWikiPageLabelRetLinkSitePagePunct($id,'');
if($link eq '') {
return "$site:$pg$punct";
}
return $link.$punct;
}

sub StoreInterWikiPageLabelErs {
my ($iwp,$label,$ers)=@_;
my ($link,$site,$pg,$punct)=InterWikiPageLabelRetLinkSitePagePunct($iwp,$label);
if($link eq '') { # store no empty links
return $ers;
#NOTE: NOT return StoreRaw($ers); important because of rescan
}
return StoreRaw($link).$punct;
}

sub RtfHr {
return '{\pard \fs5 {\brdrb\brdrdot\brdrw20\brsp20 \par} }';
}

sub SetHr {
if($RtfMode) {
return RtfHr();
}
return "<hr>";
}

sub TextMarkupImagesLinks {
my $showImage=$_[1];
my $showLinks=$_[2];

if($HtmlTags) {
my $t;
foreach $t (@HtmlPairs) {
$_[0] =~ s/\<$t(\s[^<>]+?)?\>(.*?)\<\/$t\>/<$t$1>$2<\/$t>/gis;
}
foreach $t (@HtmlSingle) {
$_[0] =~ s/\<$t(\s[^<>]+?)?\>/<$t$1>/gi;
}
} else { # Note that these tags are restricted to a single line
$_[0] =~ s/\<(sub|sup|tt|b|i|u)\>(.*?)\<\/\1\>/<$1>$2<\/$1>/gio;
$_[0] =~ s/\<br( \/)?\>/<br \/>/gio;
}
if($showLinks) {
$_[0] =~ s/\[$UrlPattern\s+([^[\]]+)\]/&StoreBracketUrl($2,$6)/geo;
$_[0] =~ s/\[$UrlPattern\]/&StoreBracketUrl($1,"")/geo;
$_[0] =~ s/\[$InterWebPattern\]/&StoreBracketInterWikiPage($1)/geo;
$_[0] =~ s/(\[)$InterWebPattern\s+([^[\]]+)\]/&StoreInterWikiPageLabelErs($2,$5,"[$2 $5]")/geo;

if($UploadUrl ne '') {
$_[0] =~ s/(^|$SepLetter)$UploadPattern/$1.&StoreUploadLink($3)/geo;
}
$_[0] =~ s/(^|$SepLetter)$UrlPattern/$1.&StoreUrl($2,$showImage)/geo;
$_[0] =~ s/(^|$SepLetter)$InterWebPattern/$1.&StoreInterWikiPageLabelErs($2,'',$2)/geo;
$_[0] =~ s/(^|$SepLetter)$RFCPattern/$1.&StoreRFC($2)/geo;
$_[0] =~ s/(^|$SepLetter)$ISBNPattern/$1.&StoreISBN($2)/geo;

if($FreeLinks) {
$_[0] =~ s/{{$FreePattern}}/&PageRefLabelStoreLink($1,$2,$1,1,1,0,'',0)/geo;
}
$_[0] =~ s/(\[)$WikiPatternRef\s+([^[\]]+)\]/&PageRefLabelStoreLink($2,$3,$4,0,1,1,'',1)/geo;
if($WikiAutoLink) {
$_[0] =~ s/(^|$SepLetter)$WikiPatternRef/&PageRefLabelStoreLink($2,$3,$2.$3,0,1,1,$1,0)/geo;
}
if($WordAutoLink) {
$_[0] =~ s/(^|$SepLetter)$WordPatternRef(?=$SepLetter|$)/&WordRefLabelStoreLink($2,$3,$2.$3,0,0,1,$1,0)/geo;
}
}
$_[0] =~ s/
+/&SetHr()/ge;
if($UseSmiley) {
$_[0] =~ s/(:-?\)|:-?\(|;-?\)|:::\))/&WikiSmiley($1)/geo;
}
if($NoLinkSep ne "") {
$_[0] =~ s/$NoLinkSep//g; # shoud be better than 6 quotes
}
}

sub StoreWikiHeader {
my ($depth,$text,$hint,$pos) = @_;
my $bcol=($hint eq ) ? : $TitleColor;
my $fcol=($hint eq '') ? '#000000' : $TitleFontColor;
my $luft=($hint eq '') ? 0 : 2;
my $name=$text;

$depth=length($depth);
$depth=6 if($depth>6);
$depth=7-$depth;

return StoreRaw(CreateTitle('',$text,$depth,$luft,$bcol,$fcol,$pos,++$HeaderCount));
}

sub LineMarkupBasic {
if($RtfMode) {
$_[0] =~ s/('*)(.*?)/$1\{\\b $2\}/g;
$_[0] =~ s/(.*?)/\{\\i $1\}/g;
} else {
$_[0] =~ s/('*)(.*?)/$1<strong>$2<\/strong>/g;
$_[0] =~ s/(.*?)/<em>$1<\/em>/g;
}
if($ShortHeader) {
$_[0] =~ s/^$HeaderPattern$/&StoreWikiHeader($1,$2,$3,$MatchPos)/geo;
}
}

sub LineMarkupImageLinksBasic { # $text,$showImage,$showLinks,$doBasic
TextMarkupImagesLinks($_[0],$_[1],$_[2]);
if($_[3]) {
LineMarkupBasic($_[0]);
}
}

sub ListStackInit {
@ListStack=();
}

sub ListStackExit {
my ($html);

while(@ListStack>0) {
$html.="</".pop(@ListStack).">\n";
}
if($RtfMode) {
if($html ne '') {
return "}\n\\par\n";
} else {
return '';
}
}
ListStackInit();
return $html;
}

sub ListStackApp {
my ($code,$depth)=@_;
my ($html,$oldCode,$cx,$pre);
my $init=(0==@ListStack);

if($depth<1) { # Protect from bad depth
return '';
}

if($depth>$IndentLimit) {
$depth=$IndentLimit;
}

while(@ListStack>$depth) {
$html .= "</".pop(@ListStack).">\n";
}

$oldCode = pop(@ListStack);
if($oldCode ne $code) {
if($oldCode ne '') {
$html.="</$oldCode>";
}
$html .= "<$code>\n";
}

push(@ListStack,$code);
while(@ListStack<$depth) {
push(@ListStack,$code);
$html .= "<$code>\n";
}

if($RtfMode) {
$html=; $pre=;
if($code eq 'ul') {
$pre="\\bullet";
} elsif($code eq 'ol') {
$pre="1.";
}
if($oldCode ne $code) {
if($oldCode ne '') {
$html="}\n\\par\n";
}
}
if($init) {
$html.="{\\intbl\\li0\\ri120\n";
}
$cx=$depth*600;
$html.="\\trowd\\tcelld\\cellx$cx\\qr{$pre}\\cell\\tcelld\\cellx$RtfBodyWidth\\ql{";
}
return $html;
}

sub LineMarkupLists {
$_=$_[0];
my $doLists=$_[1];
my ($save stack,$html,$add);
if( m/^\s*$/ ) {
$add="<p>\n"; #rtf=>end
if($RtfMode) {
if(@ListStack>0) {
$add="\\trowd\\tcelld\\cellx".$RtfBodyWidth."{}\\cell\\row";
} else {
$add='';
}
}
$html .= $add;
} else {
if($doLists) {
$save stack=0;
if( s#^(\;+)\s*([^:]+\:?)\.*)$#<dt>$2</dt><dd>$3</dd># ) {
$html .= ListStackApp("dl",length $1); $save stack=1;
if($RtfMode) {
s/^<dt>$2<dd>//;
}
# } elsif( s#^(\:+)\s*(.*)$#<dt></dt><dd>$2</dd># ) { nok Opera
} elsif( s#^(\:+)\s*(.?[\(\[][ nvx]?[\)\]])?(.*)$#"<dt></dt><dd>".CdmlSymbol($2).$3#e ) {
$html .= ListStackApp("dl",length $1); $save stack=1;
if($RtfMode) {
s#^<dt></dt><dd>##;
}
} elsif( s#^(\*+)\s*(.?[\(\[][ nvx]?[\)\]])?(.*)$#"<li>".CdmlSymbol($2).$3."</li>"#e ) {
$html .= ListStackApp("ul",length $1); $save stack=1;
if($RtfMode) {
s#^<li>(.*)</li>#$1#;
}
} elsif( s#^(\#+)\s*(.*)$#<li>$2</li># ) {
$html .= ListStackApp("ol",length $1); $save stack=1;
if($RtfMode) {
s#^<li>(.*)</li>#$1#;
}
}
if($WhiteSpaceType>0) {
s/^(\s+)/&HtmlLuft($WhiteSpaceWidth * length($1),1)/e;
} else {
if( /^\s/) {
$html .= ListStackApp("PRE",1); $save stack=1;
}
}
if($save stack==0) { # normal text line
$html.=ListStackExit();
}
}
LineMarkupBasic($_);
if($RtfMode) {
if($save stack) {
$html.=$_."}\n\\cell\\row\n";
} else {
$html.=$_."\n<p>\n";
}
} else {
$html.=$_;
}
}
return $html;
}

sub TextMarkupImagesLinksParasLists { # $text ... $_[0]
my $doImages=$_[1];
my $doLinks=$_[2];
my $doPara=$_[3];
my $doLists=$_[4];
my $haslf=0;
my $ret;

LineMarkupImageLinksBasic($_[0],$doImages,$doLinks,1);
if($doPara>0) {
if($_[0] =~ m/\n$/) {
$haslf=1;
}
foreach(split(/\n/,$_[0])) {
$_ .= "\n";
$ret.=LineMarkupLists($_,$doLists);
}
if($haslf==0) {
$ret=~ s/\n$//;
}
$ret.=ListStackExit();
$_[0]=$ret;
}
}

sub ColorDiff {
my ($diff, $color)=@_;

$diff =~ s/(^|\n)[<>]/$1/g;
$diff = QuoteHtml($diff);

# Do some of the Wiki markup rules:
# SaveUrlClear();

$diff =~ s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige;
LineMarkupImageLinksBasic($diff,0,1,1); # No images, all patterns
$diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/geo;
$diff =~ s/\r?\n/$br/g;
return "<table width='95\%' bgcolor=#$color><tr><td>\n" . $diff . "</td></tr></table>\n";
}

sub DiffRetHtml {
my ($html)=@_;

$html .= "\n"; # FIXME: quick hack, when app without end, DiffRetHtml fails, multiple doesn't matter

$html =~ s/\n--+//g; # doesn't, because \n not exists (savety)

# Note: Need spaces before
to be different from diff section.
$lb1=Lu('Changed|Verändert|Modifié|Modificado');
$html =~ s/(^|\n)(\d+.*c.*)/$1 $br0<strong>$lb1: $2<\/strong>$br0/g;
$lb1=Lu('Deleted|Entfernt|Effacé|Quitado');
$html =~ s/(^|\n)(\d+.*d.*)/$1 $br0<strong>$lb1: $2<\/strong>$br0/g;
$lb1=Lu('Added|Hinzugefügt|Ajouté|Añadir');
$html =~ s/(^|\n)(\d+.*a.*)/$1 $br0<strong>$lb1: $2<\/strong>$br0/g;
$html =~ s/\n((<.*\n)+)/&ColorDiff($1,"ffffaf")/ge;
$html =~ s/\n((>.*\n)+)/&ColorDiff($1,"cfffcf")/ge;
return $html;
}

sub GetDiffHtml {
my ($diffType,$id,$h page)=@_;
my ($html, $diffText, $PriorName, $links, $usecomma);
my ($major, $minor, $author, $usemajor, $useminor, $useauthor);

if($diffType>3) {
$diffType=RetParam("defaultdiff", 1);
}

$links = "(";
$usecomma = 0;

$lb1=Lu("Change|Änderung|Changé|Modificación");
$major = ScriptDiffPageTextClassRetLink($ScriptName,1,$id,$lb1,"body");
$lb1=Lu("Edit|Korrektur|Edité|Corrección");
$minor = ScriptDiffPageTextClassRetLink($ScriptName,2,$id,$lb1,"body");
$lb1=LiAuthor();
$author = ScriptDiffPageTextClassRetLink($ScriptName,3,$id,$lb1,"body");

$usemajor = 0;
$useminor = 0;
$useauthor = 0;
if($diffType == 1) {
$diffText = $$h page{majordiff};
if($diffText eq "1") {
$diffText = $$h page{minordiff};
}
$PriorName=Lu("last change|letzte Änderung|dernière modification|modificación más reciente");
if($$h page{majordiff} ne "1") {
$useminor = 1;
}
if($$h page{majordiff} ne $$h page{authordiff}) {
$useauthor = 1;
}
} elsif($diffType == 2) {
$diffText = $$h page{minordiff};
$PriorName=Lu("last edit|letzte Korrektur|dernière édition|edición más reciente");
if($$h page{majordiff} ne "1") {
$usemajor = 1;
}
if($$h page{authordiff} ne "1") {
$useauthor = 1;
}
} else {
$diffText = $$h page{authordiff};
if($diffText eq "1") {
$diffText = $$h page{minordiff};
}
$PriorName=Lu("previous author|zum vorhergehenden Autor|auteur précédent|autor anterior");
if($$h page{authordiff} ne "1") {
$useminor = 1;
}
if($$h page{authordiff} ne $$h page{majordiff}) {
$usemajor = 1;
}
}
if($usemajor) {
$links .= $major;
$usecomma = 1;
}
if($useminor) {
$links .= ", " if($usecomma);
$links .= $minor;
$usecomma = 1;
}
if($useauthor) {
$links .= ", " if($usecomma);
$links .= $author;
}
if(!($usemajor || $useminor || $useauthor)) {
$links .= Lu("no other diffs|keine anderen Diffs|pas d'autres différences|no otras diferencias");
}
$links .= ", " . PageLabelClassRetLink($id,Lu("normal page display|Normalansicht|affichage normal de la page|despliegue normal de la página"),"body");
$links .= ")";

$lb1=Lu('Difference|Veränderung|Différence|Diferencia');
$html = "$lb1 ($PriorName)\n" . "$links$br" . DiffRetHtml($diffText) . "<hr>\n";
return $html;
}

sub PageSatzRetAussage {
my ($id0,$satz,$dup)=@_;
my ($key,$val,@parts,$part);
my $id=$id0;

$key="$id.$satz";
$val=$Context{$key};
if($val ne '') {
goto do ret;
}
@parts=PageNameRetWords($id,1);
foreach $part(@parts) {
$key="$part.$satz";
$val=$Context{$key};
if($val ne '') {
goto do ret;
}
}
$key="@.$satz";
$val=$Context{$key};
if($val ne '') {
if($val =~ /\[sub\]/) {
$val =~ s/\[sub\]//;
StrStripBoth($val);
$id =~ s/\/.*$//;
}
$val =~ s/^@/$id/;
goto do ret;
}

do ret:
if($dup==0) {
if($val eq $id0) {
$val='';
}
}
return $val;
}

sub PageResetVar {
$FootnoteCount=0;
$FrageCount=0;
$FrageBogenFlag=0;
}

sub PageRetHtml {
my ($id,$forcelinks)=@_;
my %page=PageRetHash($id);
PageResetVar();
return TextWikiRetHtml($page{text},$forcelinks);
}

sub SatzRetPageHtml {
my ($satz,$dup,$h page)=@_;
my ($ret,$aussage,$key,$cond);

$aussage=PageSatzRetAussage($PageCur,$satz,$dup);
if($aussage ne '') {
if(PageExist($aussage)) {
$key="$satz.suppress";
$cond=$Context{$key};
if($cond =~ s/^#//) {
if($$h page{text} =~ m/^(=+)(\s*)$cond(\s*)(=+)$/m) {
return '';
}
} elsif($cond =~ s/^\*//) {
if($PageContext{$cond} eq '') {
return '';
}
}
$ret=PageRetHtml($aussage);
}
}
return $ret;
}

sub PageRetFlat {
my ($page)=@_;
if($WikiUnicode==0) {
StrCvtUnicode($page);
}
$page =~ s#/#%#g;
return $page;
}

sub SiteRetFlat {
my ($site)=@_;
if($WikiUnicode==0) {
StrCvtUnicode($site);
}
$site =~ s# #:#g;
return $site;
}

sub SisterExportPage {
my ($type,$page)=@_;
my ($flat,$fsite,$dir,$leaf,$stem);

$fsite=SiteRetFlat(InterWikiName());
$flat=PageRetFlat($page);
$dir="$GlobalDir/sister/".PageRetDirectory($flat);
DirCreate($dir);
FileAppStr("$dir/$flat.lsi","$type$fsite\n");
if($page =~ m#/#) {
$leaf=PageRetLeaf($page);
$stem=PageRetStem($page); $stem=~s#/$##;
$flat=PageRetFlat($leaf);
$dir="$GlobalDir/sister/".PageRetDirectory($flat);
DirCreate($dir);
FileAppStr("$dir/$flat.lsi","$type$fsite:$stem\n");
}
}

sub PageRetSisterSitesHash {
my ($page)=@_;
my ($flat,$fnam,%sites);

InterWebInit();
$flat=PageRetFlat($page);
$fnam="$GlobalDir/sister/".&PageRetDirectory($flat)."/$flat.lsi";
LogFileGetHash Type($fnam,\%sites,1);
delete $sites{$SiteName};
return %sites;
}

sub PageRetLeafArray {
my ($page)=@_;
my ($flat,$fnam,%sites,@lar,$h);

if(defined($LeafHash{$page})) {
# MsgPrint("LeafHash{$page} use");
return split(/\|/,$LeafHash{$page});
}

$flat=PageRetFlat($page);
$fnam="$GlobalDir/sister/".&PageRetDirectory($flat)."/$flat.lsi";
LogFileGetHash Type($fnam,\%sites,2);
@lar=sort keys %sites;
# MsgPrint("LeafHash{$page} create");
$LeafHash{$page}=join("|",@lar);
return @lar;
}

sub PageRetSisterSitesDisplay {
my ($page)=@_;
my ($site,%sites,$ret,$body,$title,@sar,$pars);

SisterNetInit();

%sites=PageRetSisterSitesHash($page);
if($SisterNet eq '*') {
foreach $site (sort keys %sites) {
$body .= "   $site:$page   ";
}
} else {
foreach $site (keys %sites) {
if($SisterNetHash{$site}) {
if($WikiUnicode==0) {
UnicodeCvtStr($site);
}
$body .= "   $site:$page   ";
}
}
}
if($body ne '') {
$title=Lu("sister pages:|Schwesterseiten:|page soeur :|páginas hermanas:");
$pars="[Breite=90%][Luft=5][Ausrichtung=c][Titelhintergrund=hellgrün][Linienfarbe=schwarz][Linienbreite=1]";

$ret=TextWikiRetHtml("[[Tabelle]$pars$title $body]");
$ret="<hr>".$ret;
}

do ret:
return $ret;
}

sub PageRetFolderList {
my ($id,$text)=@_;
my (@pages,$npages,$page,$ret,%pinfo,@ar,$cat,%depth,%stars,$catfound,$clist,%count,$info,$h,$star,$link);
my $hk=Lu($HeadFolders);
my $bhk=PreBase().$hk;
my $fl=$FreeLetter;
$fl=~s/ //g;

StrCvtNoRegex($bhk);

if($CategoriesListPages && $UsePx) {
if($id =~ m/^$bhk/) {
$id =~ s#^$WikiBase/##;

$text =~ s/^([:*]+)\s*((?:$HeadFolders)$fl*)/ {
$star=$1;
push(@ar,$2); $stars{$2}=$star; $depth{$2}=length($1);
if($2 eq $id) {
$catfound++;
}
} /mge;

if(int(@ar)) {
if($catfound == 0) {
push(@ar,$id); $depth{$id}=1; $stars{$id}=substr($star,0,1);
}
@pages=CategoriesRetPagesGetPinfoCount(\@ar,\%pinfo,\%count);
$npages=int(@pages);
if($npages>=0) {
my $title=SiteAnzRetSeiten(,$npages,);
$clist.="
\n\n";
foreach $cat (@ar) {
$clist.=$stars{$cat}."[[green]$cat ($count{$cat})]\n";
foreach $page (@pages) {
if(StrFindWord($pinfo{$page},$cat)) {
$link=$page;
if(!($link =~ m/$WikiPattern/)) {
$link="{{$link}}"; # FIXME: care needed, if this syntax changes
}
$h=$stars{$cat};
$clist.=$h.substr($h,0,1)."$link";
$info=$pinfo{$page};
StrDelWord($info,$cat);
if(StrExist($info)) {
$clist.=" <n>( + $info )</n>";
}
$clist.="\n";
}
}
}
$ret=TextWikiRetHtml($clist);
$ret .= "<hr>$br";
foreach $page (keys %pinfo) {
$pinfo{$page}=" ($pinfo{$page})";
}
$ret .= PageListRetHtml(,$ScriptName,\@pages,\%pinfo,,,0,,0,undef,0,0,undef,undef,1);
}
} else {
@pages=FolderRetPagesGetPinfo($id,\%pinfo);
if($#pages>=0) {
$ret .= "<hr>$br";
$ret .= PageListRetHtml(,$ScriptName,\@pages,\%pinfo,,,0,,0,undef,0,0,undef,undef,1);
}
}
}
}
return $ret;
}

sub LanguageCountWord {
my ($word)=@_;
my $lang=$WordRetLanguage{$word};

if($lang ne '') {
$LanguageCount[$lang]++;
}
}

sub TextRetLanguage {
my ($text)=@_;
my ($lang,$cur,$i);
my $max=-1;

foreach (@LanguageCount) {
$_=0;
}
$text =~ s/(?<=$SepLetter)($LowerLetter+)(?=$SepLetter|$)/&LanguageCountWord($1)/geo;
for ($i=0; $i<$WikiLanguageN; $i++) {
$cur=$LanguageCount[$i];
if($cur>$max) {
$lang=$i;
$max=$cur;
}
}
return $lang;
}

sub PageGetContext {
my ($text,$h context)=@_;
%$h context=();
$text =~ s/^\*+[ \t]*([^\:\n]*):[ \t]*([^\n]*?)[ \t]*$/{$$h context{$1}=$2;}/gme;
}

sub PageContextInit {
if($PageContextFlag<1) {
PageGetContext($PageTextWiki,\%PageContext);
$PageContextFlag=1;
}
}

sub WikiTextRetLinkHashBeyond {
my ($text,$beyond)=@_;
my %hash;
my $hf=Lu($HeadFolders);

if($beyond ne '') {
while($text =~ m/$beyond/) { # FIXME: faster?
$text=$';
}
}
if($FreeLinks) {
$text =~ s/{{$FreePattern}}/$hash{&NameCvtBlanks($1)}++, ' '/ge;
}
$text=~ s/(^|$SepLetter)$WikiPattern/$hash{$2}++, ' '/ge;
$text=~ s/(^|$SepLetter)((Folder|Category|Ordner|Kategorie|Dossier|Categoría|$hf)$AnyLetter+)/$hash{$2}++, ' '/ge;
return %hash;
}

sub WikiTextRetFolderTab {
my ($text,$striphead)=@_;
my (@cats,$link);
my %links=WikiTextRetLinkHashBeyond($text,"
+");
my $hf=Lu($HeadFolders);

if($AutoFolders ne '') { # FIXME: needs dynamic contextualization
my $af=$AutoFolders;
if($af =~ m/\-\*/) {
%links=();
}
$af =~ s/\-($AnyLetter+)/delete $links{$1};/ge;
$af =~ s/\+($AnyLetter+)/$links{$1}++/ge;
}
foreach $link (keys %links) {
if($link =~ m/^(Folder|Category|Ordner|Kategorie|Dossier|Categoría|$hf)/ ) {
if($striphead>0) {
$link =~ s/^$hf//;
}
push(@cats,$link);
}
}
return sort @cats;
}

sub WikiTextRetFolderTabStr {
my ($text)=@_;
my @cats=WikiTextRetFolderTab($text);
return join(' ',@cats);
}

sub TextRetSections {
my ($text)=@_;
my (@ret,@found);
my $tlen=length($text);
my $lastpos=0;
my $pos=0;

$text=~ s/(^$HeaderPattern$)/push(@found,pos($text));$1/gme;
push(@found,$tlen);
foreach $pos (@found) {
push(@ret,substr($text,$lastpos,$pos-$lastpos));
$lastpos=$pos;
}
return @ret;
}

sub TextIndRetSection { # optimize
my ($text,$ind)=@_;
my @ar=TextRetSections($text);
return $ar[int($ind)];
}

sub TextSectionRetHash {
my ($text)=@_;
my (%hash,$line);
my $section='(root)';
my $count=0;

for $line (split('\n',$text)) {
if($line =~ m/^$HeaderPattern$/ ) {
$section=$2;
$section =~ s/$SepLetter//g;
$count++;
$hash{$count.'.title'} = $section;
$hash{$section.'.title'} = $section;
}
$hash{$count} .= "$line\n";
$hash{$section} .= "$line\n";
}

return %hash;
}

sub TextRetSectionStrip {
my ($text,$section,$strip)=@_;
my %hash=TextSectionRetHash($text);
my $ret=$hash{$section};
my $title=$hash{$section.'.title'};

if(defined $ret) {
if($strip) {
$ret =~ s/^$HeaderPattern\n//;
}
return ($ret,$title);
}
return ($text,'');
}

sub PageTextGetLevelLabelRetPages {
my ($id,$text,$h level,$h label)=@_;
my (@pages,$line,$level,$label,$found,$page);

foreach $line (split(/\n/,$text)) {
$label=; $found=0; $page=;
if( $line =~ m/^(\**)/ ) {
$level=length($1);
}
if($FreeLinks) {
if($line =~ m/{{($FreePattern)}}/) {
$page=$1; $found++;
}
}
if($found==0) {
if( $line =~ m/(\[)$WikiPattern\s+([^[\]]+)\]/ ) {
$page=$2; $found++; $label=$4;
}
}
if($found==0) {
if( $line=~ m/($SepLetter)$WikiPattern/ ) {
$page=$2; $found++;
}
}
if($found==0) {
if($WordAutoLink) {
if($line =~ m/(?<=$SepLetter)($WordPatternRef)(?=$SepLetter|$)/) {
$page=$2; $found++;
}
}
}
if($found) {
push(@pages,$page);
$$h level{$page}=$level;
if($label ne '') {
$$h label{$page}=$label;
}
}
}
return @pages;
}

sub PageGetLevelLabelRetPages {
my ($id,$h level,$h label)=@_;
my $text=PageRetText($id);
return PageTextGetLevelLabelRetPages($id,$text,$h level,$h label);
}

sub PageCdmlNameGetLevelLabelRetPages {
my ($id,$cdml,$name,$h level,$h label)=@_;
my $text=PageRetText($id);
my $body=TextCdmlNameRetBody($text,$cdml,$name);
return PageTextGetLevelLabelRetPages($id,$body,$h level,$h label);
}

sub TrailNavigation {
my ($trail,$name,$section)=@_;
my ($i,$page,@pages,$prev,$up,$next,$n1,$n2,$n3,$n4,$sn); # up,n2 reserve
my (%hlabel,%hlevel,$label,$level,@levels);

if($name ne '') {
$sn.="&name=$name";
}
if($section ne '') {
$sn.="&section=$section";
}

if(StrExist($name)) {
@pages=PageCdmlNameGetLevelLabelRetPages($trail,'(?:Dokument|document)',$name,\%hlevel,\%hlabel);
} else {
@pages=PageGetLevelLabelRetPages($trail,\%hlevel,\%hlabel);
}

for($i=0; $i<=$#pages; $i++) {
$page=$pages[$i];
$level=$hlevel{$page};
$levels[$level]=$page;
if($PageCur eq $pages[$i]) {
if($i>0) {
$prev=$pages[$i-1];
$label=$hlabel{$prev};
if($label eq '') {
$label=$prev;
}
$n1="$label |";
}
if($level>1) {
$up=$levels[$level-1];
if($up ne '' && $up ne $prev) {
$label=$hlabel{$up};
if($label eq '') {
$label=$up;
}
$n2=" ^^ $label |";
}
}
if($i<$#pages) {
$next=$pages[$i+1];
$label=$hlabel{$next};
if($label eq '') {
$label=$next;
}
$n4="| $next";
}
goto do found;
}
}
do found:
my $index=Lu("Index|Inhalt|Index|Índice");
$n3="| $trail - $index |";

my $tot="<< $n1$n2$n3$n4 >>";
$tot =~ s/\|\|/\|/g;
return "<span style='background-color: #eeeeee'>" . TextWikiRetHtml($tot) . "</span>" ;
}

sub MetaNoIndex {
$MetaTagAdd.="\n <meta name=\"robots\" content=\"noindex,nofollow\">";
}

sub TextRetCdmlName {
my ($text,$cdmlname)=@_;
my ($ret,%hash,$val);
my ($cdml,$name)=split(/\./,$cdmlname,2);

$val=TextCdmlNameRetElement($text,$cdml,$name);
if($val ne '') {
$ret=$val;
} else {
$ret="[ [$cdml] [name=$name] ... ] not found" ; # FIXME: translate
}
return $ret;
}

sub ShowPage {
my ($id,$global,$action)=@_;
my ($answer, $oldId, $allDiff, $showDiff);
my ($text,$t1,$t2,$t3,$t4,$te,$title2,$h,$eprog,%page,$timestamp,$lang,$links);
my $title=RetParam('title','');
my $show = $cgi->param("show");
my $trail=RetParam('trail','');
my $section=RetParam('section','');
my $hstrip=RetParam('strip',1);
my $name=RetParam('name','');
my $pagetype=RetParam('pagetype',$PageType);
my ($redir,$codetype,$header);

if($id =~ m/Changes/) {
if($id eq (PreBase().'RecentChanges')) {
$global=1;
if($action eq '') {
$action='rc';
}
} elsif($id eq (PreBase().'RecentChangesRss')) {
$global=1;
if($action eq '') {
$action='rss';
}
} elsif($id eq (PreBase().'GlobalChanges')) {
if($global==0) {
$global=2;
}
if($action eq '') {
$action='rcs';
}
}
}

$PageCur=$id;
%page=PageRetHash($id);
$PageLeaf=PageRetLeaf($id);

if($PageLeaf eq $ContextPageName) {
$pagetype='';
} else {
if($PageLeaf eq 'Log') {
$codetype=1;
} elsif(($pagetype ne 'wiki') && ($pagetype ne '')) {
if($AllowPageType =~ m/$pagetype/) {
my $text=$page{text};
if($pagetype eq 'text') {
ShowText($text);
return;
} elsif($pagetype eq 'code') {
$codetype=1;
} elsif($pagetype eq 'html') {
ShowHtml($text);
return;
} elsif($pagetype eq 'htmlpage') {
ShowHtmlPage($text);
return;
}
}
}
}

($PageGran,$PageParent)=PageRetGrandParent($id);

$PageIsSmallFlag = (length($page{text})<$DeletePageLimit) ? 1 : 0;
if($AutoLanguageFlag) {
$WikiLanguage=TextRetLanguage($page{text});
}

$timestamp=$page{timestamp};

my $buttons=$page{buttons};
if(StrEmpty($buttons)) {
$buttons=$te;
}
if($buttons ne "") {
$ButtonBrowserDir="/vorlagen/$buttons"; # attention: relative to browser
}

$PageTop = $id;
$PageTop =~ s|/.*||; # remove subpage

# Handle a single-level redirect
$oldId = RetParam("oldid", "");
if($oldId eq "") {
if(substr($page{text}, 0, 10) eq "#REDIRECT ") {
$oldId = $id; $redir="#REDIRECT";
}
if(substr($page{text}, 0, 15) eq "#WEITERLEITUNG ") {
$oldId = $id; $redir="#WEITERLEITUNG";
}
if($redir ne '') {
($id) = ($page{text} =~ m/$redir\s+(\S+)/);
if($id =~ m/^\{\{(.*)\}\}$/ ) {
$id=$1;
}
if(ValidId($id)) {
ReBrowsePage($id,$oldId);
}
return;
}
} else {
my $von=Lu('from %PAGE%|von %PAGE%|de %PAGE%|de %PAGE%');
$von=~ s/ %PAGE%//;
NoFollow();
my $umlink=ActionLabelClassIdTargetTitleRetLink("edit=$oldId",Lu('redirection|Weiterleitung|redirection|redirijido'),"pcom");
my $bklink=PageTitleClassRetBackLink($oldId,$oldId,"pcom",0);
$PageTitleComment="($umlink $von $bklink)";
}
if($AutoSubPageList ne '') {
my %asplhash;
my @aspl=ListSplit($AutoSubPageList);
HashAddValKeys(\%asplhash,1,@aspl,$ContextPageName);
if($asplhash{$PageLeaf}==0) {
foreach (@aspl) {
$links.=$n1.PageCompleteRefLabelClassRetOptLink("$PageCur/$_",,$_,);
StrExistApp($PageTitleComment,$n3);
}
$PageTitleComment.=">> $links";
}
}
StrExistApp($PageTitleComment,$br);

$text="";
$allDiff = RetParam("alldiff", 0);
if($allDiff != 0) {
$allDiff = RetParam("defaultdiff", 1);
}
if(($id eq 'RecentChanges') && RetParam("norcdiff", 1)) {
$allDiff = 0; # Only show if specifically requested
}
$showDiff = RetParam("diff", $allDiff);
if($showDiff) {
$text .= GetDiffHtml($showDiff,$id,\%page);
MetaNoIndex();
}

$t2=$page{text};
if($section ne '') {
if($hstrip==0 && ($section=~m/\d+/)) {
$t2=TextIndRetSection($t2,$section);
} elsif($section=~m/^cdml\.(.*)$/) {
$t2=TextRetCdmlName($t2,$1);
} else {
($t2,$title2)=TextRetSectionStrip($t2,$section,$hstrip);
if($hstrip>1) {
if($title eq '') {
$title=$title2;
}
}
}
}

$PageTextWiki=$t2;
if($UsePageContext) {
PageContextInit();
}
@AlsTab=split(/;/,$AutoLinkStrategies);

$eprog=$page{pre};
if($eprog ne "") {
$t2=TextDoProcParam($t2,$eprog,$page{proc},0);
}
if($codetype) {
$t2="<pre>".QuoteHtml($t2)."</pre>";
} else {
if($pagetype eq 'table') {
$t2="[[table]$t2]";
}
$t2=TextWikiRetHtml($t2) . "\n";
}
$eprog=$page{post};
if($eprog ne "") {
$t2=TextDoProcParam($t2,$eprog,$page{proc},1);
}

if(($ContextPageName ne '') && (PageRetLeaf($id) eq $ContextPageName)) {
$text.=$t2;
} else {
$t1=SatzRetPageHtml('auto.prepend',0,\%page);
$t3=SatzRetPageHtml('auto.append',0,\%page);
$t4=PageRetFolderList($id,$PageTextWiki);
$text .= $t1.$t2.$t3.$t4;
}

if($global>0) {
if($action eq 'rss') {
$text=ShowRcGlobalRetText($global-1,$action);
print "Content-type: text/plain\n\n";
print $text;
return;
} else {
$text .= "<hr>" . ShowRcGlobalRetText($global-1,$action) . "\n";
}
}
if($trail ne '') {
if($text =~ m/<(p|br)>$/) {
} else {
$text.=$br;
}
$text.=TrailNavigation($trail,$name,$section).$br;
}

if($SisterNet ne '') {
$text.=PageRetSisterSitesDisplay($id);
}
if($show eq 'ze') {
$text =~ s#([\r\n]+)#&ShowEol($1)#ges;
}

if($title eq '') {
$title = QuoteHtml($id);
}
$h=$Context{"page.title"};
if($h ne "") {
$title=$h;
}
my $strip=First($WikiBase,$PageTitleStrip);
if($strip ne '') {
$title =~ s#^$strip/##;
}
if($title ne '-') {
$header=PageTitleClassRetBackLink($id,$title,"title",1);
}
$answer=TemplateIdTitleHeaderTextLinkSearchRetPage($TemplateFile,$id,$title,$header,$text,1,1,$timestamp);
PrintAnswer($answer);

if($GrafletDir ne '') {
my @files=DirRetFiles($GrafletDir);
my $file;
foreach $file (@files) {
if($GrafletFiles{$file}<1) {
FileDel($file);
}
}
}
}

sub PageNormalize {
$_[0] =~ s#^/+##;
$_[0] =~ s#//+#/#;
}

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

if($action ne '') {
goto do action;
}
if(!$cgi->param) { # no pars
$id=RetPageDefault();
goto do browse;
}
$id=RetParam("keywords","");
# MsgPrint("ActionIdNormalize id=$id");
if($id ne '') { # Just script?PageName
$id =~ s/>$//; # Corrcting errors of some browsers in handling e-mail URLS
goto do browse;
}
$id=RetParam('browse');
if($id ne '') {
goto do browse;
}
$id=RetParam('edit');
if($id ne '') {
$action='edit';
goto do action;
}
$id=RetParam('delete');
if($id ne '') {
$action='delete';
goto do action;
}
$ActionPar=RetParam('search');
if($ActionPar ne '') {
$action='search';
goto do action;
}
$ActionPar=RetParam('searchg');
if($ActionPar ne '') {
$action='searchg';
goto do action;
}
$ActionPar=RetParam('searchs');
if($ActionPar ne '') {
$action='searchs';
goto do action;
}
# illegal fall through
goto do action;

do browse:
$action='browse';
goto do action;

do action:
PageNormalize($id);
return ($action,$id);
}

sub InitRequest {
my @ScriptPath;

$ScriptUrl=$ENV{SCRIPT NAME};
@ScriptPath = split('/',$ScriptUrl);
$ScriptName=pop(@ScriptPath); # Name used in links
$ScriptUrlPath=join('/',@ScriptPath); # starts with "/" !

# The FS character is a superscript "3"
$FS = "\xb3"; $FS1 = $FS . "1"; $FS2 = $FS . "2"; $FS3 = $FS . "3";
$PageTop = "."; # Directory of the main page (used for subpages)
$InterWebInitFlag = 0;
%InterWeb = ();

if(!(-d $DataDir)) {
mkdir($DataDir,0770);
if(!(-d $DataDir)) {
ReportError("Could not go to or create $DataDir: $!");
return 0;
}
}
return 1;
}

sub KnowStrVarRetVal {
my ($line,$var)=@_;
my $ret;
if( $line =~ m#\{$var[^}]+)\}# ) {
$ret=$1;
}
return $ret;
}

sub KnowFileGetHashPtr {
my ($fnam,$h hash)=@_;
my ($s,$line);

if(-f $fnam) {
$s=FileRetStr($fnam);
foreach $line ( split("\n",$s) ) {
if( $line =~ m#^\s*{(.*).*)}\s*$# ) {
$$h hash{$1}=$2;
}
}
}
}

sub KnowFileSetHashPtr {
my ($fnam,$h hash)= @_;
my ($key,$val,$s);
foreach $key (sort keys(%$h hash)) {
$s .= "{$key:" . $$h hash{$key} . "}\n";
}
FileSetStr($fnam,$s);
}

sub UserGetData {
my ($user,$h hash)=@_;
my $sub=PageRetDirectory($user);
my $fnam="$GlobalDir/user/$sub/$user.xu";
KnowFileGetHashPtr($fnam,$h hash);
}

sub UserRetData {
my ($user)=@_;
my %info;
UserGetData($user,\%info);
return %info;
}

sub SessionCookieSetNameCheck {
my ($name,$check)=@_;
$SessionCookie{session} = "1";
$SessionCookie{username} = $name;
$SessionCookie{check} = $check;
$SessionCookie{rev} = 2;
}

sub SessionCookieLogout {
SessionCookieSetNameCheck(,);
}

sub WikiLoadUserStatus {
my ($usergate)=@_;
my ($status,%info);

# MsgPrint("WikiLoadUserStatus usergate=$usergate");
if($DomainGateTransportsLogin) {
if($usergate ne '') {
# MsgPrint(" info loaded");
%info=UserRetData($usergate);
}
}
if($info{Password} ne '') {
# MsgPrint(" gate ok");
$SessionUserName=$usergate;
$SessionCheck=$info{Check};
SessionCookieSetNameCheck($SessionUserName,$SessionCheck);
} else {
# MsgPrint(" gate not ok");
%SessionCookieInput=$cgi->cookie($CookieSession);
$SessionUserName=$SessionCookieInput{username};
$SessionCheck=$SessionCookieInput{check};
}

if($UserPref ne '') {
$UserStatus='User';
$UserStatusOrigin='Prefs';
}

if($SessionUserName eq "") {
goto do return;
}
$UserName=$SessionUserName;
$UserStatus="User";
$UserStatusOrigin="Session";

if($UserName ne '') {
UserGetData($UserName,\%GlobalUserData);
}
my $g check=$GlobalUserData{"Check"};
if($SessionCheck ne $g check) {
%GlobalUserData=();
$UserStatusOrigin="SessionError";
goto do return;
}
$UserStatus="Login";
$UserStatusOrigin="Global";

$status= $GlobalUserData{"UserStatus[$CookieName]"};
if( StatusRetWeight($status) > StatusRetWeight($UserStatus) ) {
$UserStatus=$status;
$UserStatusOrigin="WikiLocal";
}

$status= $GlobalUserData{"UserStatus"};
if( StatusRetWeight($status) > StatusRetWeight($UserStatus) ) {
$UserStatus=$status;
$UserStatusOrigin="Global";
}

do return:
if($UserName ne || $UserPref ne ) {
$TrustedFlag=1;
}
}

sub UserPrefsFilename {
my ($cid,$ext)=@_;

if($cid<1) {
return "";
}
if($ext eq '') {
$ext='.dp';
}
return $UserDir."/".($cid%10)."/$cid$ext";
}

sub UserPrefsExist {
my ($cid)=@_;
my $fnam=UserPrefsFilename($cid);
if($fnam eq '') {
return 0;
}
if(-f $fnam) {
return 1;
}
return 0;
}

sub CidRetPrefs { # FIXME: fold with LoadUserPrefs
my ($cid)=@_;
my ($fnam,$data,%prefs);

$fnam=UserPrefsFilename($cid);
$data=FileRetStr($fnam,1);
%prefs=split(/$FS1/,$data,-1); # -1 keeps trailing null fields
return %prefs;
}

sub LoadUserPrefs {
my ($fnam, $data);

%UserPrefs=();
$fnam=UserPrefsFilename($CookieID);
$data=FileRetStr($fnam,1);
if($data eq '') { # error or file cleaned
$CookieID='';
%GetCookie=();
} else {
%UserPrefs=split(/$FS1/,$data,-1); # -1 keeps trailing null fields
if($UserPrefs{cid} eq '') { # remove name inconsistency, keep until 2008
$UserPrefs{cid}=$UserPrefs{id};
}
delete $UserPrefs{id};
}
}

sub LoadCookieUserPrefs {
my $dgt in=RetParam('dgt');
my $dgt cid=int($dgt in);
my ($ts,$version,$ip,$dgt,$user,$action,$id,$url);
my ($usergate,$fnam,%prefs);

%PrefsCookie=();
$TimeZoneOffset = ($Def tzoffset + $TimeSummer)* 3600;

# MsgPrint("dgt in=$dgt in dgt cid=$dgt cid ClientIP=$ClientIP HTTP REFERER=$Referer");
if($dgt cid>400) {
$fnam=UserPrefsFilename($dgt cid,'.dc');
foreach (reverse FileRetArray($fnam)) {
($ts,$version,$ip,$dgt,$user,$action,$id,$url)=split(/\s+/,$_);
if($dgt in eq $dgt) {
# check time, nicht notwendig
# MsgPrint(" dgt ts=$ts ip=$ip referer=$url ");
if($ip eq $ClientIP) {
if($Referer eq $url) {
%prefs=CidRetPrefs($dgt cid);
$CookieID=$PrefsCookie{cid}=$GetCookie{cid}=$dgt cid;
$PrefsCookie{randkey}=$GetCookie{randkey}=$prefs{randkey};
$PrefsCookie{expires}=$GetCookie{expires}=$prefs{expires};
$PrefsCookie{rev}=$GetCookie{rev}=$prefs{rev};
# MsgPrint(" prefs cid=$PrefsCookie{cid} randkey=$PrefsCookie{randkey} rev=$PrefsCookie{rev} expires=$PrefsCookie{expires} ");
$DomainGateStatus='p';
if($user ne '-') {
$usergate=$user;
}
goto do gate ok;
}
}
goto do gate notfound;
}
}
}

do gate notfound:
%GetCookie = $cgi->cookie($CookieName);
if($GetCookie{cid} eq '') { # remove name inconsistency, keep until 2008
$GetCookie{cid}=$GetCookie{id};
}
delete $GetCookie{id};
$CookieID=$GetCookie{cid};

do gate ok:
$CookieID =~ s/\D//g; # Numeric only
if($CookieID < 1) {
$CookieID = 111; # means (1) no cookie exists (2) browser may have cookies turned off
} else {
LoadUserPrefs($CookieID);
}
if($CookieID > 199) { # cookie ids above that must be consistent with prefs file content
if( ($UserPrefs{cid} != $GetCookie{cid}) || ($UserPrefs{randkey} != $GetCookie{randkey}) ) {
$CookieID = 113; # Invalid cookie. FIXME: consider warning message
%UserPrefs=();
}
}
if($UserPrefs{tzoffset} != 0) {
$TimeZoneOffset = ($UserPrefs{tzoffset} + $TimeSummer) * 3600;
}
$ExpirePage=RetParam("expirepage",0);
$UserPref=RetParam("username","");

WikiLoadUserStatus($usergate);
}

sub UrlLabelRetRedirect {
my ($url,$label)=@_;
my $html;

$html.="Status: 302 Moved\r\n"; # $html = $cgi -> redirect(-uri=>$url);
$html.="location: $url\r\n";
$html.="\r\n";

$html.="\nYour browser should go to the $label page.";
$html.=" If it does not, click <a href='$url'>$label</a> to continue.\n";
return $html;
}

sub RequestRetProtocol {
my $ret='http';
if($ENV{HTTPS} eq 'on') {
$ret='https';
}
return $ret;
}

sub QuerySetId {
my ($query,$id)=@_;
if($query ne '') {
if($query =~ m/=/) {
$query =~ s/(?<=&id=)([^&]*)/$id/;
} else {
$query=$id;
}
} else {
$query=$id;
}
$_[0]=$query;
$_[1]=$id;
}

sub UrlCreateDomainId {
my ($domain,$id)=@_;

my $url=$cgi->url(-full=>1);
if($domain ne '') {
UrlSetDomain($url,$domain);
}

my $query=$ENV{QUERY STRING};
if( ($id ne '') && ($id ne '*') ) {
QuerySetId($query,$id);
}

if($query ne '') {
$url.="?".$query;
}
return $url;
}

sub RedirectProtocol {
my ($newprotocol)=@_;
my ($url1,$url2,$html);

$url1=UrlCreateDomainId();
$url2=$url1;
$url2 =~ s#^.*:#$newprotocol:#;
# MsgPrint("RedirectProtocol $url1 => $url2");
$html=UrlLabelRetRedirect($url2,"here");
PrintAnswer($html);
return 0;
}

sub RedirectDomainPage {
my ($newdomain,$id2)=@_;
my ($url2,$html);
$url2=UrlCreateDomainId($newdomain,$id2);
$html=UrlLabelRetRedirect($url2,"here");
PrintAnswer($html);
return 0;
}

sub RetRedirectPage {
my ($newid)=@_;
my ($url,$html,$fullurl);

$fullurl=$cgi->url(-full=>1);
if($PlusAllowed) {
if(!($newid=~/=/)) {
if($newid=~/[+]/) {
$newid="action=browse&id=".$newid;
}
}
}
$url="$fullurl?$newid";
if($NonEnglish) {
$url= StrRetNecEsc($url);
}
UrlNormalizeAmp($url);
$html=UrlLabelRetRedirect($url,$newid);
return $html;
}

sub ReBrowsePage {
my ($id, $oldId)=@_;
my $answer;

if($oldId ne "") { # break recursion FIXME: maybe count>3def?
$id="action=browse&id=$id&oldid=$oldId";
}
$answer=RetRedirectPage($id);
PrintAnswer($answer);
}

sub TextLevelRetHeader {
my ($text,$n)=@_;
if($n>6) {
$n=6;
}
return "<h$n>$text</h$n>\n";
}

sub ScriptIdSectionRetIconLink {
my ($script,$id,$section)=@_;
my $action="action=edit&id=$id&section=$section";
if($LinkRewrite) {
ScriptCvtIdAction($script,$id,$action);
}
my $url=ScriptActionRetUrl($script,$action);
my $lab="<img src='/image/icon edit.gif' border='0'>";
return "<a href='$url'>$lab</a>";
}

sub CreateTitle {
my ($name0,$body,$size0,$luft,$bcol,$fcol,$pos,$headercount)=@_;
my $size=$size0;
my ($toc,$name1,$name2,$name3,$body2,$top,$cf,$cb,$ret,$par,$title,$hnr,$iconedit);

if($RtfMode) {
$size=$RtfBodySize+4+$size0*2;
if($size0>3) {
$size+=$size0*2;
}
if($fcol) {
$cf="\\cf".RtfColorTabRetInd($fcol);
$par="\\par";
}
if($bcol) {
$cb="\\clcbpat".RtfColorTabRetInd($bcol);
$par='';
}
$ret="{\\f1\\fs$size\\b$cf $body$par}";
if($bcol) {
$ret="{\\intbl\\trowd\\li60\\ri60\\sb60\\sa60\\tcelld$cb\\cellx$RtfBodyWidth\\ql$ret\\cell\\row}";
}
return $ret;
}

if($name0 eq '') {
$name0=$body;
}
$name0 =~ s/$FS(\d+)$FS/&GetSaveUrl($1)/ge;
StrStripHtml($name0);

$body2=$name0;
$body2=~ s/[Š]//g;
$body2=~ s/''+//g;

$name0 =~ s/^\s*//;
$name1=$name0;
$name2=$name0;

$name1 =~ s/$SepLetter.*//g;
$name2 =~ s/$SepLetter//g;
$TocHash{sprintf("%09d",$pos)}="$size0|$name2|$body2";

if(($name1 ne '') && ($name1 ne $name2)) {
$name1="<a name='$name1'></a>";
} else {
$name1='';
}
if($name2 ne '') {
$name2="<a name='$name2'></a>";
}
if($headercount) {
$name3="<a name='section$headercount'></a>";
}

if($TocFlag>0 && $TocTopFlag>0 && $RtfMode==0) {
$toc="$n3<a href='#toc'><img src='/image/toc up.gif' border='0' height='12' width='12'></a> ";
}
if($SectionEditing && $headercount) {
$iconedit=ScriptIdSectionRetIconLink($ScriptName,$PageCur,$headercount);
}

if($UseHtmlTitle) {
$hnr=7-$size0;
if($hnr<1) {
$hnr=1;
}
if($hnr>6) {
$hnr=6;
}
my ($style,$bt,$ft);
if($bcol ne '') {
$bt=" background:$bcol;"
}
if($fcol ne '') {
$ft=" color:$fcol;"
}
if($bt ne || $ft ne ) {
$style=" style=\"$bt$ft\"";
}
if($iconedit) {
$iconedit="<div style=' float:right; '>$iconedit</div>";
}
#nok $title="<h$hnr$style><table border='0' cellspacing=0 cellpadding='0' style='border-color:transparent; border:0 0 0 0; margin:0 0 0 0; padding:0 0 0 0;' ><tr><td>$body$toc</td><td>$iconedit</td></tr></table></h$hnr>";
$title="<h$hnr$style>$iconedit$body$toc</h$hnr>";
} else {
if($bcol ne '') {
$bcol="bgcolor='$bcol'";
}
$luft="cellpadding='$luft'";
$size="size='$size'";
if($fcol ne '') {
$fcol=" color='$fcol'";
}
$title="<table width='100%' $luft border='0' $bcol><tr><td width='95%'><font $size$fcol class='h$size0'>$body$toc</font></td><td align='right' width='5%'>$iconedit</td></tr></table>";
}
return "$name1$name2$name3$title";
}

sub WikiSmiley {
my ($pat)=@_;
my $nam;

if($RtfMode) {
return $pat;
}

if(($pat eq "") || $pat eq "") {
$nam="smile";
} elsif($pat eq "" || $pat eq "") {
$nam="frown";
} elsif($pat eq "" || $pat eq "") {
$nam="wink";
} elsif($pat eq ":::") {
$nam="happy";
}
return NameStyleRetImageGif("s_$nam",$LinkTypeIconStyle);
}

]

sub FolderRetPagesGetPinfo {
  my ($cat,$h_pinfo)=@_;
  my ($page,@pages,$cats,$leaf,$cat2);
  my $showcount=($cat eq LuFirst($SearchTextFolders,$PageFolders)) ? 1 : 0;

  %$h_pinfo=();
  StrCvtNoRegex($cat);

  PageIndexInit();
LOOP:
  foreach $page (keys %PageIndex) {
    $leaf=PageRetLeaf($page);
    if($leaf eq $ContextPageName) {
      next LOOP;
    }
    if($WikiBase ne '') {
      if(!($page =~ m#^$WikiBase/# )) {
        next LOOP;
      }
    }
    $cats=$PageIndex{$page};
    if($cats =~ m/(^|\W)$cat(\W|$)/) {
      push(@pages,$page);
    }
    if($showcount) {
      foreach $cat2 (split(' ',$cats)) {
        if($WikiBase ne '') {
          $cat2="$WikiBase/$cat2";
        }
        $$h_pinfo{$cat2}++;
      }
    }
  }
  @pages=ArraySort(@pages);
  if($showcount) {
    foreach $page (@pages) {
      $$h_pinfo{$page}=" ($$h_pinfo{$page})";
    }
  }
  return @pages;
}

sub CategoriesRetPagesGetPinfoCount {
  my ($h_car,$h_pinfo,$h_count)=@_;
  my ($page,@pages,$cats,$leaf,$cat2,$found,$cat);
  my @car=@$h_car;

  foreach (@car) {
    StrCvtNoRegex($_);
  }

  PageIndexInit();
LOOP:
  foreach $page (keys %PageIndex) {
    $leaf=PageRetLeaf($page);
    if($leaf eq $ContextPageName) {
      next LOOP;
    }
    if($WikiBase ne '') {
      if(!($page =~ m#^$WikiBase/# )) {
        next LOOP;
      }
    }
    $cats=$PageIndex{$page};
    $found=0;
    foreach $cat2 (split(' ',$cats)) {
      foreach $cat (@car) {
        if($cat eq $cat2) {
          $found++;
          $$h_pinfo{$page}=join(' ',$$h_pinfo{$page},$cat);
          $$h_count{$cat}++;
        }
      }
    }
    if($found) {
      push(@pages,$page);
    }
  }
  @pages=ArraySort(@pages);
  return @pages;
}

sub SiteAnzRetSeiten {
  my ($site,$anz,$found)=@_;
  my $ret;

  if($found ne '') {
    if($anz == 0) {
      $lb1=Lu('No page found|Keine Seite gefunden|Pas de page trouvées|No hay página encontrados');
    } elsif($anz==1) {
      $lb1=Lu('1 page found|1 Seite gefunden|1 page trouvées|1 página encontrados');
    } else {
      $lb1=Lu('%COUNT% pages found|%COUNT% Seiten gefunden|%COUNT% pages trouvées|%COUNT% páginas encontrados');
      MessRepVar($lb1,"%COUNT%",$anz);
    }
  } else {
    if($anz == 0) {
      $lb1=Lu('No page|Keine Seite|Pas de page|No hay página');
    } elsif($anz==1) {
      $lb1=Lu('1 page|1 Seite|1 page|1 página');
    } else {
      $lb1=Lu('%COUNT% pages|%COUNT% Seiten|%COUNT% pages|%COUNT% páginas');
      MessRepVar($lb1,"%COUNT%",$anz);
    }
  }
  $ret=$lb1;
  if($site ne '') {
    $lb2=Lu('in %WIKINAME%|im %WIKINAME%|dans %WIKINAME%|en %WIKINAME%');
    MessRepVar($lb2,"%WIKINAME%",$site);
    $ret.= "$lb2";
  }
  if($anz==0) {
    $ret.='.';
  } else {
    $ret.=':';
  }
  return $ret;
}

sub StrCountRetStr {
  my ($s,$count)=@_;
  my $ret;
  if($count>0) {
    $ret=$s x $count;
  }
  return $ret;
}

sub StrRetChrFirst {
  my $c=substr($_[0],0,1);
  if($WikiUnicode) {
    if(ord($c)>127) {
      $c=substr($_[0],0,2);
    }
  }
  return $c;
}

sub PageListRetHtml {
  my ($site,$script,$a_pages,$h_pinfo,$gef,$noindent,$notitle,$layout,$anzshow,$h_order,$rev,$showheader0,$h_label,$h_link,$index)=@_;
  my ($head,$ret,$label,$pagename,$count,$anz,$title,$body,$pars,$line,$c0,$c1,$hcount,$info);
  my ($editcolumn,$align);
  my $showheader=RetParam('header',$showheader0);
  my $pre=PreBase();
  my (%hlink,%hpre,%hlabel);
  my $bullets=($layout eq '*') ? 1 : 0;
  my @pages=@$a_pages;

  if(defined($h_label)) {
    %hlabel=%$h_label;
  } else {
    foreach $pagename (@pages) {
      $label=$pagename;
      if($WikiBase ne '') {
        if($pagename =~ m#^$WikiBase/#) {
          $label =~ s#^$WikiBase/##;
        } else {
          next;
        }
      }
      if($noindent<1) {
        if($label =~ m|/|) {
          $count = ($label =~ tr#/##);
          $hpre{$pagename} = StrCountRetStr("... ",$count);
        }
      }
      if($site ne '') {
        $label="$site:$label";
      }
      $label =~ s/_+/ /g;
      $hlabel{$pagename}=$label;
    }
  }
  if(defined($h_link)) {
    %hlink=%$h_link;
  } else {
    foreach $pagename (@pages) {
      $hlink{$pagename}=ScriptPageRefLabelClassCompleteRetLink($script,$pagename,'',$hlabel{$pagename},"body",1);
    }
  }

  if(defined($h_order)) {
    @pages=HashRetTabSortedStr($h_order,$rev);
  }

  $anz=int(@pages);
  $title=SiteAnzRetSeiten($site,$anz,$gef);

  if($anzshow>0 && $anzshow<$anz) {
    $title=$anzshow . Lu(" of | von | de | de ") . $title;
    splice(@pages,$anzshow,int(@pages))
  }
  if(StrEquList($layout,'Tabelle','table')) {
    $align="l";
    $pars="";
    if(defined($h_pinfo)) {
      $title.= ";" . Lu("date of last change|Datum der letzten Änderung|date de la dernière modification|fecha de la modificación más reciente");
      $align.="c";
      if($$h_pinfo{"column.edit"}) {
        $title.= "; ".LiEdit();
        $editcolumn=1;
        $align.="c";
      }
    }
    foreach $pagename (@pages) {
      $line=$hpre{$pagename} . "[Top:action=browse&id=$pagename $hlabel{$pagename}]";
      if(defined($h_pinfo)) {
        $line .= ";".$$h_pinfo{$pagename};
        if($editcolumn) {
          $line.= "; ".$$h_pinfo{"edit.$pagename"};
        }
      }
      $body.=$line.$br;
    }
    $ret=TextWikiRetHtmlBasic("
$pars$title\n$body
"); } else { if($notitle<1) { $head="<h2>$title</h2>\n"; } foreach $pagename (@pages) { $line=$hpre{$pagename}.$hlink{$pagename}.$$h_pinfo{$pagename}; if($showheader) { $c1=StrRetChrFirst($hlabel{$pagename}); if($c1 ne $c0) { $body.="<h4>$c1</h4>\n"; $hcount=0; } } if($bullets && $hcount==0) { $body.="<ul>\n"; } if($index) { if($VidaCaching && ($IndexAutoTalk ne '')) { $info=PageVarRetAutoTalkWiki($pagename,$IndexAutoTalk,2); if($info ne '') { $info=TextWikiRetHtml($info); } } } if($bullets) { $body.="<li>$line.$info</li>\n"; } else { $body.=$line.$info.$br; } $hcount++; $c0=$c1; } if($bullets && $hcount) { $body.="</ul>"; } $ret=$head.$body.$br; } return $ret; } sub StoreBracketUrl { my ($url,$name)=@_; my ($index,$link,$hidden,$target); $name=~ s#^Upload:#$UploadUrl/#; if($name ne '') { if(NameIsUrl($name) && NameIsImage($name)) { if($AutoExtLinkEmptyTarget) { $target="target=\"_blank\""; } $name =~ s/\.(DECLARE)?IMAGE$//; return StoreRaw("<a href='$url' $target style='background-color: white; border-bottom:solid 0px white;'><img src='$name' border='0'></a>"); } else { if($ShowHiddenLinks) { $hidden=" ($url)"; } } return StoreRaw(UrlLabelTypeRetLink($url,$name).$hidden); } $index=GetBracketUrlIndex($url); if($NonEnglish) { $url=StrRetNecEsc($url); } $link=UrlLabelTargetTypeRetLink($url,"[$index]",'','-'); return StoreRaw($link); } sub InterWikiPageRetLink { my ($id)=@_; my ($link,$site,$pg,$punct)=InterWikiPageLabelRetLinkSitePagePunct($id,''); if($link eq '') { return "$site:$pg$punct"; } return $link.$punct; } sub StoreInterWikiPageLabelErs { my ($iwp,$label,$ers)=@_; my ($link,$site,$pg,$punct)=InterWikiPageLabelRetLinkSitePagePunct($iwp,$label); if($link eq '') { # store no empty links return $ers; #NOTE: NOT return StoreRaw($ers); important because of rescan } return StoreRaw($link).$punct; } sub RtfHr { return '{\pard \fs5 {\brdrb\brdrdot\brdrw20\brsp20 \par} }'; } sub SetHr { if($RtfMode) { return RtfHr(); } return "<hr>"; } sub TextMarkupImagesLinks { my $showImage=$_[1]; my $showLinks=$_[2]; if($HtmlTags) { my $t; foreach $t (@HtmlPairs) { $_[0] =~ s/\<$t(\s[^<>]+?)?\>(.*?)\<\/$t\>/<$t$1>$2<\/$t>/gis; } foreach $t (@HtmlSingle) { $_[0] =~ s/\<$t(\s[^<>]+?)?\>/<$t$1>/gi; } } else { # Note that these tags are restricted to a single line $_[0] =~ s/\<(sub|sup|tt|b|i|u)\>(.*?)\<\/\1\>/<$1>$2<\/$1>/gio; $_[0] =~ s/\<br( \/)?\>/<br \/>/gio; } if($showLinks) { $_[0] =~ s/\[$UrlPattern\s+([^[\]]+)\]/&StoreBracketUrl($2,$6)/geo; $_[0] =~ s/\[$UrlPattern\]/&StoreBracketUrl($1,"")/geo; $_[0] =~ s/\[$InterWebPattern\]/&StoreBracketInterWikiPage($1)/geo; $_[0] =~ s/(\[)$InterWebPattern\s+([^[\]]+)\]/&StoreInterWikiPageLabelErs($2,$5,"[$2 $5]")/geo; if($UploadUrl ne '') { $_[0] =~ s/(^|$SepLetter)$UploadPattern/$1.&StoreUploadLink($3)/geo; } $_[0] =~ s/(^|$SepLetter)$UrlPattern/$1.&StoreUrl($2,$showImage)/geo; $_[0] =~ s/(^|$SepLetter)$InterWebPattern/$1.&StoreInterWikiPageLabelErs($2,'',$2)/geo; $_[0] =~ s/(^|$SepLetter)$RFCPattern/$1.&StoreRFC($2)/geo; $_[0] =~ s/(^|$SepLetter)$ISBNPattern/$1.&StoreISBN($2)/geo; if($FreeLinks) { $_[0] =~ s/{{$FreePattern}}/&PageRefLabelStoreLink($1,$2,$1,1,1,0,'',0)/geo; } $_[0] =~ s/(\[)$WikiPatternRef\s+([^[\]]+)\]/&PageRefLabelStoreLink($2,$3,$4,0,1,1,'',1)/geo; if($WikiAutoLink) { $_[0] =~ s/(^|$SepLetter)$WikiPatternRef/&PageRefLabelStoreLink($2,$3,$2.$3,0,1,1,$1,0)/geo; } if($WordAutoLink) { $_[0] =~ s/(^|$SepLetter)$WordPatternRef(?=$SepLetter|$)/&WordRefLabelStoreLink($2,$3,$2.$3,0,0,1,$1,0)/geo; } } $_[0] =~ s/----+/&SetHr()/ge; if($UseSmiley) { $_[0] =~ s/(:-?\)|:-?\(|;-?\)|:::\))/&WikiSmiley($1)/geo; } if($NoLinkSep ne "") { $_[0] =~ s/$NoLinkSep//g; # shoud be better than 6 quotes } } sub StoreWikiHeader { my ($depth,$text,$hint,$pos) = @_; my $bcol=($hint eq '') ? '' : $TitleColor; my $fcol=($hint eq '') ? '#000000' : $TitleFontColor; my $luft=($hint eq '') ? 0 : 2; my $name=$text; $depth=length($depth); $depth=6 if($depth>6); $depth=7-$depth; return StoreRaw(CreateTitle('',$text,$depth,$luft,$bcol,$fcol,$pos,++$HeaderCount)); } sub LineMarkupBasic { if($RtfMode) { $_[0] =~ s/('*)'''(.*?)'''/$1\{\\b $2\}/g; $_[0] =~ s/''(.*?)''/\{\\i $1\}/g; } else { $_[0] =~ s/('*)'''(.*?)'''/$1<strong>$2<\/strong>/g; $_[0] =~ s/''(.*?)''/<em>$1<\/em>/g; } if($ShortHeader) { $_[0] =~ s/^$HeaderPattern$/&StoreWikiHeader($1,$2,$3,$MatchPos)/geo; } } sub LineMarkupImageLinksBasic { # $text,$showImage,$showLinks,$doBasic TextMarkupImagesLinks($_[0],$_[1],$_[2]); if($_[3]) { LineMarkupBasic($_[0]); } } sub ListStackInit { @ListStack=(); } sub ListStackExit { my ($html); while(@ListStack>0) { $html.="</".pop(@ListStack).">\n"; } if($RtfMode) { if($html ne '') { return "}\n\\par\n"; } else { return ''; } } ListStackInit(); return $html; } sub ListStackApp { my ($code,$depth)=@_; my ($html,$oldCode,$cx,$pre); my $init=(0==@ListStack); if($depth<1) { # Protect from bad depth return ''; } if($depth>$IndentLimit) { $depth=$IndentLimit; } while(@ListStack>$depth) { $html .= "</".pop(@ListStack).">\n"; } $oldCode = pop(@ListStack); if($oldCode ne $code) { if($oldCode ne '') { $html.="</$oldCode>"; } $html .= "<$code>\n"; } push(@ListStack,$code); while(@ListStack<$depth) { push(@ListStack,$code); $html .= "<$code>\n"; } if($RtfMode) { $html=''; $pre=''; if($code eq 'ul') { $pre="\\bullet"; } elsif($code eq 'ol') { $pre="1."; } if($oldCode ne $code) { if($oldCode ne '') { $html="}\n\\par\n"; } } if($init) { $html.="{\\intbl\\li0\\ri120\n"; } $cx=$depth*600; $html.="\\trowd\\tcelld\\cellx$cx\\qr{$pre}\\cell\\tcelld\\cellx$RtfBodyWidth\\ql{"; } return $html; } sub LineMarkupLists { $_=$_[0]; my $doLists=$_[1]; my ($save_stack,$html,$add); if( m/^\s*$/ ) { $add="<p>\n"; #rtf=>end if($RtfMode) { if(@ListStack>0) { $add="\\trowd\\tcelld\\cellx".$RtfBodyWidth."{}\\cell\\row"; } else { $add=''; } } $html .= $add; } else { if($doLists) { $save_stack=0; if( s#^(\;+)\s*([^:]+\:?)\:(.*)$#<dt>$2</dt><dd>$3</dd># ) { $html .= ListStackApp("dl",length $1); $save_stack=1; if($RtfMode) { s/^<dt>$2<dd>//; } # } elsif( s#^(\:+)\s*(.*)$#<dt></dt><dd>$2</dd># ) { nok Opera } elsif( s#^(\:+)\s*(.?[\(\[][ nvx]?[\)\]])?(.*)$#"<dt></dt><dd>".CdmlSymbol($2).$3#e ) { $html .= ListStackApp("dl",length $1); $save_stack=1; if($RtfMode) { s#^<dt></dt><dd>##; } } elsif( s#^(\*+)\s*(.?[\(\[][ nvx]?[\)\]])?(.*)$#"<li>".CdmlSymbol($2).$3."</li>"#e ) { $html .= ListStackApp("ul",length $1); $save_stack=1; if($RtfMode) { s#^<li>(.*)</li>#$1#; } } elsif( s#^(\#+)\s*(.*)$#<li>$2</li># ) { $html .= ListStackApp("ol",length $1); $save_stack=1; if($RtfMode) { s#^<li>(.*)</li>#$1#; } } if($WhiteSpaceType>0) { s/^(\s+)/&HtmlLuft($WhiteSpaceWidth * length($1),1)/e; } else { if( /^\s/) { $html .= ListStackApp("PRE",1); $save_stack=1; } } if($save_stack==0) { # normal text line $html.=ListStackExit(); } } LineMarkupBasic($_); if($RtfMode) { if($save_stack) { $html.=$_."}\n\\cell\\row\n"; } else { $html.=$_."\n<p>\n"; } } else { $html.=$_; } } return $html; } sub TextMarkupImagesLinksParasLists { # $text ... $_[0] my $doImages=$_[1]; my $doLinks=$_[2]; my $doPara=$_[3]; my $doLists=$_[4]; my $haslf=0; my $ret; LineMarkupImageLinksBasic($_[0],$doImages,$doLinks,1); if($doPara>0) { if($_[0] =~ m/\n$/) { $haslf=1; } foreach(split(/\n/,$_[0])) { $_ .= "\n"; $ret.=LineMarkupLists($_,$doLists); } if($haslf==0) { $ret=~ s/\n$//; } $ret.=ListStackExit(); $_[0]=$ret; } } sub ColorDiff { my ($diff, $color)=@_; $diff =~ s/(^|\n)[<>]/$1/g; $diff = QuoteHtml($diff); # Do some of the Wiki markup rules: # SaveUrlClear(); $diff =~ s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige; LineMarkupImageLinksBasic($diff,0,1,1); # No images, all patterns $diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/geo; $diff =~ s/\r?\n/$br/g; return "<table width='95\%' bgcolor=#$color><tr><td>\n" . $diff . "</td></tr></table>\n"; } sub DiffRetHtml { my ($html)=@_; $html .= "\n"; # FIXME: quick hack, when app without end, DiffRetHtml fails, multiple doesn't matter $html =~ s/\n--+//g; # doesn't, because \n not exists (savety) # Note: Need spaces before <br> to be different from diff section. $lb1=Lu('Changed|Verändert|Modifié|Modificado'); $html =~ s/(^|\n)(\d+.*c.*)/$1 $br0<strong>$lb1: $2<\/strong>$br0/g; $lb1=Lu('Deleted|Entfernt|Effacé|Quitado'); $html =~ s/(^|\n)(\d+.*d.*)/$1 $br0<strong>$lb1: $2<\/strong>$br0/g; $lb1=Lu('Added|Hinzugefügt|Ajouté|Añadir'); $html =~ s/(^|\n)(\d+.*a.*)/$1 $br0<strong>$lb1: $2<\/strong>$br0/g; $html =~ s/\n((<.*\n)+)/&ColorDiff($1,"ffffaf")/ge; $html =~ s/\n((>.*\n)+)/&ColorDiff($1,"cfffcf")/ge; return $html; } sub GetDiffHtml { my ($diffType,$id,$h_page)=@_; my ($html, $diffText, $PriorName, $links, $usecomma); my ($major, $minor, $author, $usemajor, $useminor, $useauthor); if($diffType>3) { $diffType=RetParam("defaultdiff", 1); } $links = "("; $usecomma = 0; $lb1=Lu("Change|Änderung|Changé|Modificación"); $major = ScriptDiffPageTextClassRetLink($ScriptName,1,$id,$lb1,"body"); $lb1=Lu("Edit|Korrektur|Edité|Corrección"); $minor = ScriptDiffPageTextClassRetLink($ScriptName,2,$id,$lb1,"body"); $lb1=LiAuthor(); $author = ScriptDiffPageTextClassRetLink($ScriptName,3,$id,$lb1,"body"); $usemajor = 0; $useminor = 0; $useauthor = 0; if($diffType == 1) { $diffText = $$h_page{majordiff}; if($diffText eq "1") { $diffText = $$h_page{minordiff}; } $PriorName=Lu("last change|letzte Änderung|dernière modification|modificación más reciente"); if($$h_page{majordiff} ne "1") { $useminor = 1; } if($$h_page{majordiff} ne $$h_page{authordiff}) { $useauthor = 1; } } elsif($diffType == 2) { $diffText = $$h_page{minordiff}; $PriorName=Lu("last edit|letzte Korrektur|dernière édition|edición más reciente"); if($$h_page{majordiff} ne "1") { $usemajor = 1; } if($$h_page{authordiff} ne "1") { $useauthor = 1; } } else { $diffText = $$h_page{authordiff}; if($diffText eq "1") { $diffText = $$h_page{minordiff}; } $PriorName=Lu("previous author|zum vorhergehenden Autor|auteur précédent|autor anterior"); if($$h_page{authordiff} ne "1") { $useminor = 1; } if($$h_page{authordiff} ne $$h_page{majordiff}) { $usemajor = 1; } } if($usemajor) { $links .= $major; $usecomma = 1; } if($useminor) { $links .= ", " if($usecomma); $links .= $minor; $usecomma = 1; } if($useauthor) { $links .= ", " if($usecomma); $links .= $author; } if(!($usemajor || $useminor || $useauthor)) { $links .= Lu("no other diffs|keine anderen Diffs|pas d'autres différences|no otras diferencias"); } $links .= ", " . PageLabelClassRetLink($id,Lu("normal page display|Normalansicht|affichage normal de la page|despliegue normal de la página"),"body"); $links .= ")"; $lb1=Lu('Difference|Veränderung|Différence|Diferencia'); $html = "<b>$lb1 ($PriorName)</b>\n" . "$links$br" . DiffRetHtml($diffText) . "<hr>\n"; return $html; } sub PageSatzRetAussage { my ($id0,$satz,$dup)=@_; my ($key,$val,@parts,$part); my $id=$id0; $key="$id.$satz"; $val=$Context{$key}; if($val ne '') { goto do_ret; } @parts=PageNameRetWords($id,1); foreach $part(@parts) { $key="$part.$satz"; $val=$Context{$key}; if($val ne '') { goto do_ret; } } $key="@.$satz"; $val=$Context{$key}; if($val ne '') { if($val =~ /\[sub\]/) { $val =~ s/\[sub\]//; StrStripBoth($val); $id =~ s/\/.*$//; } $val =~ s/^@/$id/; goto do_ret; } do_ret: if($dup==0) { if($val eq $id0) { $val=''; } } return $val; } sub PageResetVar { $FootnoteCount=0; $FrageCount=0; $FrageBogenFlag=0; } sub PageRetHtml { my ($id,$forcelinks)=@_; my %page=PageRetHash($id); PageResetVar(); return TextWikiRetHtml($page{text},$forcelinks); } sub SatzRetPageHtml { my ($satz,$dup,$h_page)=@_; my ($ret,$aussage,$key,$cond); $aussage=PageSatzRetAussage($PageCur,$satz,$dup); if($aussage ne '') { if(PageExist($aussage)) { $key="$satz.suppress"; $cond=$Context{$key}; if($cond =~ s/^#//) { if($$h_page{text} =~ m/^(=+)(\s*)$cond(\s*)(=+)$/m) { return ''; } } elsif($cond =~ s/^\*//) { if($PageContext{$cond} eq '') { return ''; } } $ret=PageRetHtml($aussage); } } return $ret; } sub PageRetFlat { my ($page)=@_; if($WikiUnicode==0) { StrCvtUnicode($page); } $page =~ s#/#%#g; return $page; } sub SiteRetFlat { my ($site)=@_; if($WikiUnicode==0) { StrCvtUnicode($site); } $site =~ s# #:#g; return $site; } sub SisterExportPage { my ($type,$page)=@_; my ($flat,$fsite,$dir,$leaf,$stem); $fsite=SiteRetFlat(InterWikiName()); $flat=PageRetFlat($page); $dir="$GlobalDir/sister/".PageRetDirectory($flat); DirCreate($dir); FileAppStr("$dir/$flat.lsi","$type$fsite\n"); if($page =~ m#/#) { $leaf=PageRetLeaf($page); $stem=PageRetStem($page); $stem=~s#/$##; $flat=PageRetFlat($leaf); $dir="$GlobalDir/sister/".PageRetDirectory($flat); DirCreate($dir); FileAppStr("$dir/$flat.lsi","$type$fsite:$stem\n"); } } sub PageRetSisterSitesHash { my ($page)=@_; my ($flat,$fnam,%sites); InterWebInit(); $flat=PageRetFlat($page); $fnam="$GlobalDir/sister/".&PageRetDirectory($flat)."/$flat.lsi"; LogFileGetHash_Type($fnam,\%sites,1); delete $sites{$SiteName}; return %sites; } sub PageRetLeafArray { my ($page)=@_; my ($flat,$fnam,%sites,@lar,$h); if(defined($LeafHash{$page})) { # MsgPrint("LeafHash{$page} use"); return split(/\|/,$LeafHash{$page}); } $flat=PageRetFlat($page); $fnam="$GlobalDir/sister/".&PageRetDirectory($flat)."/$flat.lsi"; LogFileGetHash_Type($fnam,\%sites,2); @lar=sort keys %sites; # MsgPrint("LeafHash{$page} create"); $LeafHash{$page}=join("|",@lar); return @lar; } sub PageRetSisterSitesDisplay { my ($page)=@_; my ($site,%sites,$ret,$body,$title,@sar,$pars); SisterNetInit(); %sites=PageRetSisterSitesHash($page); if($SisterNet eq '*') { foreach $site (sort keys %sites) { $body .= "   $site:$page   "; } } else { foreach $site (keys %sites) { if($SisterNetHash{$site}) { if($WikiUnicode==0) { UnicodeCvtStr($site); } $body .= "   $site:$page   "; } } } if($body ne '') { $title=Lu("sister pages:|Schwesterseiten:|page soeur :|páginas hermanas:"); $pars=""; $ret=TextWikiRetHtml("
$pars$title $body
"); $ret="<hr>".$ret; } do_ret: return $ret; } sub PageRetFolderList { my ($id,$text)=@_; my (@pages,$npages,$page,$ret,%pinfo,@ar,$cat,%depth,%stars,$catfound,$clist,%count,$info,$h,$star,$link); my $hk=Lu($HeadFolders); my $bhk=PreBase().$hk; my $fl=$FreeLetter; $fl=~s/ //g; StrCvtNoRegex($bhk); if($CategoriesListPages && $UsePx) { if($id =~ m/^$bhk/) { $id =~ s#^$WikiBase/##; $text =~ s/^([:*]+)\s*((?:$HeadFolders)$fl*)/ { $star=$1; push(@ar,$2); $stars{$2}=$star; $depth{$2}=length($1); if($2 eq $id) { $catfound++; } } /mge; if(int(@ar)) { if($catfound == 0) { push(@ar,$id); $depth{$id}=1; $stars{$id}=substr($star,0,1); } @pages=CategoriesRetPagesGetPinfoCount(\@ar,\%pinfo,\%count); $npages=int(@pages); if($npages>=0) { my $title=SiteAnzRetSeiten('',$npages,''); $clist.="----\n\n"; foreach $cat (@ar) { $clist.=$stars{$cat}."$cat ($count{$cat})\n"; foreach $page (@pages) { if(StrFindWord($pinfo{$page},$cat)) { $link=$page; if(!($link =~ m/$WikiPattern/)) { $link="{{$link}}"; # FIXME: care needed, if this syntax changes } $h=$stars{$cat}; $clist.=$h.substr($h,0,1)."$link"; $info=$pinfo{$page}; StrDelWord($info,$cat); if(StrExist($info)) { $clist.=" ( + $info )"; } $clist.="\n"; } } } $ret=TextWikiRetHtml($clist); $ret .= "<hr>$br"; foreach $page (keys %pinfo) { $pinfo{$page}=" ($pinfo{$page})"; } $ret .= PageListRetHtml('',$ScriptName,\@pages,\%pinfo,'','',0,'',0,undef,0,0,undef,undef,1); } } else { @pages=FolderRetPagesGetPinfo($id,\%pinfo); if($#pages>=0) { $ret .= "<hr>$br"; $ret .= PageListRetHtml('',$ScriptName,\@pages,\%pinfo,'','',0,'',0,undef,0,0,undef,undef,1); } } } } return $ret; } sub LanguageCountWord { my ($word)=@_; my $lang=$WordRetLanguage{$word}; if($lang ne '') { $LanguageCount[$lang]++; } } sub TextRetLanguage { my ($text)=@_; my ($lang,$cur,$i); my $max=-1; foreach (@LanguageCount) { $_=0; } $text =~ s/(?<=$SepLetter)($LowerLetter+)(?=$SepLetter|$)/&LanguageCountWord($1)/geo; for ($i=0; $i<$WikiLanguageN; $i++) { $cur=$LanguageCount[$i]; if($cur>$max) { $lang=$i; $max=$cur; } } return $lang; } sub PageGetContext { my ($text,$h_context)=@_; %$h_context=(); $text =~ s/^\*+[ \t]*([^\:\n]*):[ \t]*([^\n]*?)[ \t]*$/{$$h_context{$1}=$2;}/gme; } sub PageContextInit { if($PageContextFlag<1) { PageGetContext($PageTextWiki,\%PageContext); $PageContextFlag=1; } } sub WikiTextRetLinkHashBeyond { my ($text,$beyond)=@_; my %hash; my $hf=Lu($HeadFolders); if($beyond ne '') { while($text =~ m/$beyond/) { # FIXME: faster? $text=$'; } } if($FreeLinks) { $text =~ s/{{$FreePattern}}/$hash{&NameCvtBlanks($1)}++, ' '/ge; } $text=~ s/(^|$SepLetter)$WikiPattern/$hash{$2}++, ' '/ge; $text=~ s/(^|$SepLetter)((Folder|Category|Ordner|Kategorie|Dossier|Categoría|$hf)$AnyLetter+)/$hash{$2}++, ' '/ge; return %hash; } sub WikiTextRetFolderTab { my ($text,$striphead)=@_; my (@cats,$link); my %links=WikiTextRetLinkHashBeyond($text,"----+"); my $hf=Lu($HeadFolders); if($AutoFolders ne '') { # FIXME: needs dynamic contextualization my $af=$AutoFolders; if($af =~ m/\-\*/) { %links=(); } $af =~ s/\-($AnyLetter+)/delete $links{$1};/ge; $af =~ s/\+($AnyLetter+)/$links{$1}++/ge; } foreach $link (keys %links) { if($link =~ m/^(Folder|Category|Ordner|Kategorie|Dossier|Categoría|$hf)/ ) { if($striphead>0) { $link =~ s/^$hf//; } push(@cats,$link); } } return sort @cats; } sub WikiTextRetFolderTabStr { my ($text)=@_; my @cats=WikiTextRetFolderTab($text); return join(' ',@cats); } sub TextRetSections { my ($text)=@_; my (@ret,@found); my $tlen=length($text); my $lastpos=0; my $pos=0; $text=~ s/(^$HeaderPattern$)/push(@found,pos($text));$1/gme; push(@found,$tlen); foreach $pos (@found) { push(@ret,substr($text,$lastpos,$pos-$lastpos)); $lastpos=$pos; } return @ret; } sub TextIndRetSection { # optimize my ($text,$ind)=@_; my @ar=TextRetSections($text); return $ar[int($ind)]; } sub TextSectionRetHash { my ($text)=@_; my (%hash,$line); my $section='(root)'; my $count=0; for $line (split('\n',$text)) { if($line =~ m/^$HeaderPattern$/ ) { $section=$2; $section =~ s/$SepLetter//g; $count++; $hash{$count.'.title'} = $section; $hash{$section.'.title'} = $section; } $hash{$count} .= "$line\n"; $hash{$section} .= "$line\n"; } return %hash; } sub TextRetSectionStrip { my ($text,$section,$strip)=@_; my %hash=TextSectionRetHash($text); my $ret=$hash{$section}; my $title=$hash{$section.'.title'}; if(defined $ret) { if($strip) { $ret =~ s/^$HeaderPattern\n//; } return ($ret,$title); } return ($text,''); } sub PageTextGetLevelLabelRetPages { my ($id,$text,$h_level,$h_label)=@_; my (@pages,$line,$level,$label,$found,$page); foreach $line (split(/\n/,$text)) { $label=''; $found=0; $page=''; if( $line =~ m/^(\**)/ ) { $level=length($1); } if($FreeLinks) { if($line =~ m/{{($FreePattern)}}/) { $page=$1; $found++; } } if($found==0) { if( $line =~ m/(\[)$WikiPattern\s+([^[\]]+)\]/ ) { $page=$2; $found++; $label=$4; } } if($found==0) { if( $line=~ m/($SepLetter)$WikiPattern/ ) { $page=$2; $found++; } } if($found==0) { if($WordAutoLink) { if($line =~ m/(?<=$SepLetter)($WordPatternRef)(?=$SepLetter|$)/) { $page=$2; $found++; } } } if($found) { push(@pages,$page); $$h_level{$page}=$level; if($label ne '') { $$h_label{$page}=$label; } } } return @pages; } sub PageGetLevelLabelRetPages { my ($id,$h_level,$h_label)=@_; my $text=PageRetText($id); return PageTextGetLevelLabelRetPages($id,$text,$h_level,$h_label); } sub PageCdmlNameGetLevelLabelRetPages { my ($id,$cdml,$name,$h_level,$h_label)=@_; my $text=PageRetText($id); my $body=TextCdmlNameRetBody($text,$cdml,$name); return PageTextGetLevelLabelRetPages($id,$body,$h_level,$h_label); } sub TrailNavigation { my ($trail,$name,$section)=@_; my ($i,$page,@pages,$prev,$up,$next,$n1,$n2,$n3,$n4,$sn); # up,n2 reserve my (%hlabel,%hlevel,$label,$level,@levels); if($name ne '') { $sn.="&name=$name"; } if($section ne '') { $sn.="&section=$section"; } if(StrExist($name)) { @pages=PageCdmlNameGetLevelLabelRetPages($trail,'(?:Dokument|document)',$name,\%hlevel,\%hlabel); } else { @pages=PageGetLevelLabelRetPages($trail,\%hlevel,\%hlabel); } for($i=0; $i<=$#pages; $i++) { $page=$pages[$i]; $level=$hlevel{$page}; $levels[$level]=$page; if($PageCur eq $pages[$i]) { if($i>0) { $prev=$pages[$i-1]; $label=$hlabel{$prev}; if($label eq '') { $label=$prev; } $n1="[ThisWiki:action=browse&id=$prev&trail=$trail$sn $label] |"; } if($level>1) { $up=$levels[$level-1]; if($up ne '' && $up ne $prev) { $label=$hlabel{$up}; if($label eq '') { $label=$up; } $n2=" ^^ [ThisWiki:action=browse&id=$up&trail=$trail$sn $label] |"; } } if($i<$#pages) { $next=$pages[$i+1]; $label=$hlabel{$next}; if($label eq '') { $label=$next; } $n4="| [ThisWiki:action=browse&id=$next&trail=$trail$sn $next]"; } goto do_found; } } do_found: my $index=Lu("Index|Inhalt|Index|Índice"); $n3="| [ThisWiki:$trail#name $trail] - $index |"; my $tot="<< $n1$n2$n3$n4 >>"; $tot =~ s/\|\|/\|/g; return "<span style='background-color: #eeeeee'>" . TextWikiRetHtml($tot) . "</span>" ; } sub MetaNoIndex { $MetaTagAdd.="\n <meta name=\"robots\" content=\"noindex,nofollow\">"; } sub TextRetCdmlName { my ($text,$cdmlname)=@_; my ($ret,%hash,$val); my ($cdml,$name)=split(/\./,$cdmlname,2); $val=TextCdmlNameRetElement($text,$cdml,$name); if($val ne '') { $ret=$val; } else { $ret="[ [$cdml] [name=$name] ... ] not found" ; # FIXME: translate } return $ret; } sub ShowPage { my ($id,$global,$action)=@_; my ($answer, $oldId, $allDiff, $showDiff); my ($text,$t1,$t2,$t3,$t4,$te,$title2,$h,$eprog,%page,$timestamp,$lang,$links); my $title=RetParam('title',''); my $show = $cgi->param("show"); my $trail=RetParam('trail',''); my $section=RetParam('section',''); my $hstrip=RetParam('strip',1); my $name=RetParam('name',''); my $pagetype=RetParam('pagetype',$PageType); my ($redir,$codetype,$header); if($id =~ m/Changes/) { if($id eq (PreBase().'RecentChanges')) { $global=1; if($action eq '') { $action='rc'; } } elsif($id eq (PreBase().'RecentChangesRss')) { $global=1; if($action eq '') { $action='rss'; } } elsif($id eq (PreBase().'GlobalChanges')) { if($global==0) { $global=2; } if($action eq '') { $action='rcs'; } } } $PageCur=$id; %page=PageRetHash($id); $PageLeaf=PageRetLeaf($id); if($PageLeaf eq $ContextPageName) { $pagetype=''; } else { if($PageLeaf eq 'Log') { $codetype=1; } elsif(($pagetype ne 'wiki') && ($pagetype ne '')) { if($AllowPageType =~ m/$pagetype/) { my $text=$page{text}; if($pagetype eq 'text') { ShowText($text); return; } elsif($pagetype eq 'code') { $codetype=1; } elsif($pagetype eq 'html') { ShowHtml($text); return; } elsif($pagetype eq 'htmlpage') { ShowHtmlPage($text); return; } } } } ($PageGran,$PageParent)=PageRetGrandParent($id); $PageIsSmallFlag = (length($page{text})<$DeletePageLimit) ? 1 : 0; if($AutoLanguageFlag) { $WikiLanguage=TextRetLanguage($page{text}); } $timestamp=$page{timestamp}; my $buttons=$page{buttons}; if(StrEmpty($buttons)) { $buttons=$te; } if($buttons ne "") { $ButtonBrowserDir="/vorlagen/$buttons"; # attention: relative to browser } $PageTop = $id; $PageTop =~ s|/.*||; # remove subpage # Handle a single-level redirect $oldId = RetParam("oldid", ""); if($oldId eq "") { if(substr($page{text}, 0, 10) eq "#REDIRECT ") { $oldId = $id; $redir="#REDIRECT"; } if(substr($page{text}, 0, 15) eq "#WEITERLEITUNG ") { $oldId = $id; $redir="#WEITERLEITUNG"; } if($redir ne '') { ($id) = ($page{text} =~ m/$redir\s+(\S+)/); if($id =~ m/^\{\{(.*)\}\}$/ ) { $id=$1; } if(ValidId($id)) { ReBrowsePage($id,$oldId); } return; } } else { my $von=Lu('from %PAGE%|von %PAGE%|de %PAGE%|de %PAGE%'); $von=~ s/ %PAGE%//; NoFollow(); my $umlink=ActionLabelClassIdTargetTitleRetLink("edit=$oldId",Lu('redirection|Weiterleitung|redirection|redirijido'),"pcom"); my $bklink=PageTitleClassRetBackLink($oldId,$oldId,"pcom",0); $PageTitleComment="($umlink $von $bklink)"; } if($AutoSubPageList ne '') { my %asplhash; my @aspl=ListSplit($AutoSubPageList); HashAddValKeys(\%asplhash,1,@aspl,$ContextPageName); if($asplhash{$PageLeaf}==0) { foreach (@aspl) { $links.=$n1.PageCompleteRefLabelClassRetOptLink("$PageCur/$_",'',$_,''); StrExistApp($PageTitleComment,$n3); } $PageTitleComment.=">> $links"; } } StrExistApp($PageTitleComment,$br); $text=""; $allDiff = RetParam("alldiff", 0); if($allDiff != 0) { $allDiff = RetParam("defaultdiff", 1); } if(($id eq 'RecentChanges') && RetParam("norcdiff", 1)) { $allDiff = 0; # Only show if specifically requested } $showDiff = RetParam("diff", $allDiff); if($showDiff) { $text .= GetDiffHtml($showDiff,$id,\%page); MetaNoIndex(); } $t2=$page{text}; if($section ne '') { if($hstrip==0 && ($section=~m/\d+/)) { $t2=TextIndRetSection($t2,$section); } elsif($section=~m/^cdml\.(.*)$/) { $t2=TextRetCdmlName($t2,$1); } else { ($t2,$title2)=TextRetSectionStrip($t2,$section,$hstrip); if($hstrip>1) { if($title eq '') { $title=$title2; } } } } $PageTextWiki=$t2; if($UsePageContext) { PageContextInit(); } @AlsTab=split(/;/,$AutoLinkStrategies); $eprog=$page{pre}; if($eprog ne "") { $t2=TextDoProcParam($t2,$eprog,$page{proc},0); } if($codetype) { $t2="
".QuoteHtml($t2)."
"; } else { if($pagetype eq 'table') { $t2="
$t2
"; } $t2=TextWikiRetHtml($t2) . "\n"; } $eprog=$page{post}; if($eprog ne "") { $t2=TextDoProcParam($t2,$eprog,$page{proc},1); } if(($ContextPageName ne '') && (PageRetLeaf($id) eq $ContextPageName)) { $text.=$t2; } else { $t1=SatzRetPageHtml('auto.prepend',0,\%page); $t3=SatzRetPageHtml('auto.append',0,\%page); $t4=PageRetFolderList($id,$PageTextWiki); $text .= $t1.$t2.$t3.$t4; } if($global>0) { if($action eq 'rss') { $text=ShowRcGlobalRetText($global-1,$action); print "Content-type: text/plain\n\n"; print $text; return; } else { $text .= "<hr>" . ShowRcGlobalRetText($global-1,$action) . "\n"; } } if($trail ne '') { if($text =~ m/<(p|br)>$/) { } else { $text.=$br; } $text.=TrailNavigation($trail,$name,$section).$br; } if($SisterNet ne '') { $text.=PageRetSisterSitesDisplay($id); } if($show eq 'ze') { $text =~ s#([\r\n]+)#&ShowEol($1)#ges; } if($title eq '') { $title = QuoteHtml($id); } $h=$Context{"page.title"}; if($h ne "") { $title=$h; } my $strip=First($WikiBase,$PageTitleStrip); if($strip ne '') { $title =~ s#^$strip/##; } if($title ne '-') { $header=PageTitleClassRetBackLink($id,$title,"title",1); } $answer=TemplateIdTitleHeaderTextLinkSearchRetPage($TemplateFile,$id,$title,$header,$text,1,1,$timestamp); PrintAnswer($answer); if($GrafletDir ne '') { my @files=DirRetFiles($GrafletDir); my $file; foreach $file (@files) { if($GrafletFiles{$file}<1) { FileDel($file); } } } } sub PageNormalize { $_[0] =~ s#^/+##; $_[0] =~ s#//+#/#; } sub ActionIdNormalize { my ($action,$id)=@_; if($action ne '') { goto do_action; } if(!$cgi->param) { # no pars $id=RetPageDefault(); goto do_browse; } $id=RetParam("keywords",""); # MsgPrint("ActionIdNormalize id=$id"); if($id ne '') { # Just script?PageName $id =~ s/>$//; # Corrcting errors of some browsers in handling e-mail URLS goto do_browse; } $id=RetParam('browse'); if($id ne '') { goto do_browse; } $id=RetParam('edit'); if($id ne '') { $action='edit'; goto do_action; } $id=RetParam('delete'); if($id ne '') { $action='delete'; goto do_action; } $ActionPar=RetParam('search'); if($ActionPar ne '') { $action='search'; goto do_action; } $ActionPar=RetParam('searchg'); if($ActionPar ne '') { $action='searchg'; goto do_action; } $ActionPar=RetParam('searchs'); if($ActionPar ne '') { $action='searchs'; goto do_action; } # illegal fall through goto do_action; do_browse: $action='browse'; goto do_action; do_action: PageNormalize($id); return ($action,$id); } sub InitRequest { my @ScriptPath; $ScriptUrl=$ENV{SCRIPT_NAME}; @ScriptPath = split('/',$ScriptUrl); $ScriptName=pop(@ScriptPath); # Name used in links $ScriptUrlPath=join('/',@ScriptPath); # starts with "/" ! # The FS character is a superscript "3" $FS = "\xb3"; $FS1 = $FS . "1"; $FS2 = $FS . "2"; $FS3 = $FS . "3"; $PageTop = "."; # Directory of the main page (used for subpages) $InterWebInitFlag = 0; %InterWeb = (); if(!(-d $DataDir)) { mkdir($DataDir,0770); if(!(-d $DataDir)) { ReportError("Could not go to or create $DataDir: $!"); return 0; } } return 1; } sub KnowStrVarRetVal { my ($line,$var)=@_; my $ret; if( $line =~ m#\{$var:([^}]+)\}# ) { $ret=$1; } return $ret; } sub KnowFileGetHashPtr { my ($fnam,$h_hash)=@_; my ($s,$line); if(-f $fnam) { $s=FileRetStr($fnam); foreach $line ( split("\n",$s) ) { if( $line =~ m#^\s*{(.*):(.*)}\s*$# ) { $$h_hash{$1}=$2; } } } } sub KnowFileSetHashPtr { my ($fnam,$h_hash)= @_; my ($key,$val,$s); foreach $key (sort keys(%$h_hash)) { $s .= "{$key:" . $$h_hash{$key} . "}\n"; } FileSetStr($fnam,$s); } sub UserGetData { my ($user,$h_hash)=@_; my $sub=PageRetDirectory($user); my $fnam="$GlobalDir/user/$sub/$user.xu"; KnowFileGetHashPtr($fnam,$h_hash); } sub UserRetData { my ($user)=@_; my %info; UserGetData($user,\%info); return %info; } sub SessionCookieSetNameCheck { my ($name,$check)=@_; $SessionCookie{session} = "1"; $SessionCookie{username} = $name; $SessionCookie{check} = $check; $SessionCookie{rev} = 2; } sub SessionCookieLogout { SessionCookieSetNameCheck('',''); } sub WikiLoadUserStatus { my ($usergate)=@_; my ($status,%info); # MsgPrint("WikiLoadUserStatus usergate=$usergate"); if($DomainGateTransportsLogin) { if($usergate ne '') { # MsgPrint(" info loaded"); %info=UserRetData($usergate); } } if($info{Password} ne '') { # MsgPrint(" gate ok"); $SessionUserName=$usergate; $SessionCheck=$info{Check}; SessionCookieSetNameCheck($SessionUserName,$SessionCheck); } else { # MsgPrint(" gate not ok"); %SessionCookieInput=$cgi->cookie($CookieSession); $SessionUserName=$SessionCookieInput{username}; $SessionCheck=$SessionCookieInput{check}; } if($UserPref ne '') { $UserStatus='User'; $UserStatusOrigin='Prefs'; } if($SessionUserName eq "") { goto do_return; } $UserName=$SessionUserName; $UserStatus="User"; $UserStatusOrigin="Session"; if($UserName ne '') { UserGetData($UserName,\%GlobalUserData); } my $g_check=$GlobalUserData{"Check"}; if($SessionCheck ne $g_check) { %GlobalUserData=(); $UserStatusOrigin="SessionError"; goto do_return; } $UserStatus="Login"; $UserStatusOrigin="Global"; $status= $GlobalUserData{"UserStatus[$CookieName]"}; if( StatusRetWeight($status) > StatusRetWeight($UserStatus) ) { $UserStatus=$status; $UserStatusOrigin="WikiLocal"; } $status= $GlobalUserData{"UserStatus"}; if( StatusRetWeight($status) > StatusRetWeight($UserStatus) ) { $UserStatus=$status; $UserStatusOrigin="Global"; } do_return: if($UserName ne '' || $UserPref ne '') { $TrustedFlag=1; } } sub UserPrefsFilename { my ($cid,$ext)=@_; if($cid<1) { return ""; } if($ext eq '') { $ext='.dp'; } return $UserDir."/".($cid%10)."/$cid$ext"; } sub UserPrefsExist { my ($cid)=@_; my $fnam=UserPrefsFilename($cid); if($fnam eq '') { return 0; } if(-f $fnam) { return 1; } return 0; } sub CidRetPrefs { # FIXME: fold with LoadUserPrefs my ($cid)=@_; my ($fnam,$data,%prefs); $fnam=UserPrefsFilename($cid); $data=FileRetStr($fnam,1); %prefs=split(/$FS1/,$data,-1); # -1 keeps trailing null fields return %prefs; } sub LoadUserPrefs { my ($fnam, $data); %UserPrefs=(); $fnam=UserPrefsFilename($CookieID); $data=FileRetStr($fnam,1); if($data eq '') { # error or file cleaned $CookieID=''; %GetCookie=(); } else { %UserPrefs=split(/$FS1/,$data,-1); # -1 keeps trailing null fields if($UserPrefs{cid} eq '') { # remove name inconsistency, keep until 2008 $UserPrefs{cid}=$UserPrefs{id}; } delete $UserPrefs{id}; } } sub LoadCookieUserPrefs { my $dgt_in=RetParam('dgt'); my $dgt_cid=int($dgt_in); my ($ts,$version,$ip,$dgt,$user,$action,$id,$url); my ($usergate,$fnam,%prefs); %PrefsCookie=(); $TimeZoneOffset = ($Def_tzoffset + $TimeSummer)* 3600; # MsgPrint("dgt_in=$dgt_in dgt_cid=$dgt_cid ClientIP=$ClientIP HTTP_REFERER=$Referer"); if($dgt_cid>400) { $fnam=UserPrefsFilename($dgt_cid,'.dc'); foreach (reverse FileRetArray($fnam)) { ($ts,$version,$ip,$dgt,$user,$action,$id,$url)=split(/\s+/,$_); if($dgt_in eq $dgt) { # check time, nicht notwendig # MsgPrint(" dgt ts=$ts ip=$ip referer=$url "); if($ip eq $ClientIP) { if($Referer eq $url) { %prefs=CidRetPrefs($dgt_cid); $CookieID=$PrefsCookie{cid}=$GetCookie{cid}=$dgt_cid; $PrefsCookie{randkey}=$GetCookie{randkey}=$prefs{randkey}; $PrefsCookie{expires}=$GetCookie{expires}=$prefs{expires}; $PrefsCookie{rev}=$GetCookie{rev}=$prefs{rev}; # MsgPrint(" prefs cid=$PrefsCookie{cid} randkey=$PrefsCookie{randkey} rev=$PrefsCookie{rev} expires=$PrefsCookie{expires} "); $DomainGateStatus='p'; if($user ne '-') { $usergate=$user; } goto do_gate_ok; } } goto do_gate_notfound; } } } do_gate_notfound: %GetCookie = $cgi->cookie($CookieName); if($GetCookie{cid} eq '') { # remove name inconsistency, keep until 2008 $GetCookie{cid}=$GetCookie{id}; } delete $GetCookie{id}; $CookieID=$GetCookie{cid}; do_gate_ok: $CookieID =~ s/\D//g; # Numeric only if($CookieID < 1) { $CookieID = 111; # means (1) no cookie exists (2) browser may have cookies turned off } else { LoadUserPrefs($CookieID); } if($CookieID > 199) { # cookie ids above that must be consistent with prefs file content if( ($UserPrefs{cid} != $GetCookie{cid}) || ($UserPrefs{randkey} != $GetCookie{randkey}) ) { $CookieID = 113; # Invalid cookie. FIXME: consider warning message %UserPrefs=(); } } if($UserPrefs{tzoffset} != 0) { $TimeZoneOffset = ($UserPrefs{tzoffset} + $TimeSummer) * 3600; } $ExpirePage=RetParam("expirepage",0); $UserPref=RetParam("username",""); WikiLoadUserStatus($usergate); } sub UrlLabelRetRedirect { my ($url,$label)=@_; my $html; $html.="Status: 302 Moved\r\n"; # $html = $cgi -> redirect(-uri=>$url); $html.="location: $url\r\n"; $html.="\r\n"; $html.="\nYour browser should go to the $label page."; $html.=" If it does not, click <a href='$url'>$label</a> to continue.\n"; return $html; } sub RequestRetProtocol { my $ret='http'; if($ENV{HTTPS} eq 'on') { $ret='https'; } return $ret; } sub QuerySetId { my ($query,$id)=@_; if($query ne '') { if($query =~ m/=/) { $query =~ s/(?<=&id=)([^&]*)/$id/; } else { $query=$id; } } else { $query=$id; } $_[0]=$query; $_[1]=$id; } sub UrlCreateDomainId { my ($domain,$id)=@_; my $url=$cgi->url(-full=>1); if($domain ne '') { UrlSetDomain($url,$domain); } my $query=$ENV{QUERY_STRING}; if( ($id ne '') && ($id ne '*') ) { QuerySetId($query,$id); } if($query ne '') { $url.="?".$query; } return $url; } sub RedirectProtocol { my ($newprotocol)=@_; my ($url1,$url2,$html); $url1=UrlCreateDomainId(); $url2=$url1; $url2 =~ s#^.*:#$newprotocol:#; # MsgPrint("RedirectProtocol $url1 => $url2"); $html=UrlLabelRetRedirect($url2,"here"); PrintAnswer($html); return 0; } sub RedirectDomainPage { my ($newdomain,$id2)=@_; my ($url2,$html); $url2=UrlCreateDomainId($newdomain,$id2); $html=UrlLabelRetRedirect($url2,"here"); PrintAnswer($html); return 0; } sub RetRedirectPage { my ($newid)=@_; my ($url,$html,$fullurl); $fullurl=$cgi->url(-full=>1); if($PlusAllowed) { if(!($newid=~/=/)) { if($newid=~/[+]/) { $newid="action=browse&id=".$newid; } } } $url="$fullurl?$newid"; if($NonEnglish) { $url= StrRetNecEsc($url); } UrlNormalizeAmp($url); $html=UrlLabelRetRedirect($url,$newid); return $html; } sub ReBrowsePage { my ($id, $oldId)=@_; my $answer; if($oldId ne "") { # break recursion FIXME: maybe count>3def? $id="action=browse&id=$id&oldid=$oldId"; } $answer=RetRedirectPage($id); PrintAnswer($answer); } sub TextLevelRetHeader { my ($text,$n)=@_; if($n>6) { $n=6; } return "<h$n>$text</h$n>\n"; } sub ScriptIdSectionRetIconLink { my ($script,$id,$section)=@_; my $action="action=edit&id=$id&section=$section"; if($LinkRewrite) { ScriptCvtIdAction($script,$id,$action); } my $url=ScriptActionRetUrl($script,$action); my $lab="<img src='/image/icon_edit.gif' border='0'>"; return "<a href='$url'>$lab</a>"; } sub CreateTitle { my ($name0,$body,$size0,$luft,$bcol,$fcol,$pos,$headercount)=@_; my $size=$size0; my ($toc,$name1,$name2,$name3,$body2,$top,$cf,$cb,$ret,$par,$title,$hnr,$iconedit); if($RtfMode) { $size=$RtfBodySize+4+$size0*2; if($size0>3) { $size+=$size0*2; } if($fcol) { $cf="\\cf".RtfColorTabRetInd($fcol); $par="\\par"; } if($bcol) { $cb="\\clcbpat".RtfColorTabRetInd($bcol); $par=''; } $ret="{\\f1\\fs$size\\b$cf $body$par}"; if($bcol) { $ret="{\\intbl\\trowd\\li60\\ri60\\sb60\\sa60\\tcelld$cb\\cellx$RtfBodyWidth\\ql$ret\\cell\\row}"; } return $ret; } if($name0 eq '') { $name0=$body; } $name0 =~ s/$FS(\d+)$FS/&GetSaveUrl($1)/ge; StrStripHtml($name0); $body2=$name0; $body2=~ s/[Š]//g; $body2=~ s/''+//g; $name0 =~ s/^\s*//; $name1=$name0; $name2=$name0; $name1 =~ s/$SepLetter.*//g; $name2 =~ s/$SepLetter//g; $TocHash{sprintf("%09d",$pos)}="$size0|$name2|$body2"; if(($name1 ne '') && ($name1 ne $name2)) { $name1="<a name='$name1'></a>"; } else { $name1=''; } if($name2 ne '') { $name2="<a name='$name2'></a>"; } if($headercount) { $name3="<a name='section$headercount'></a>"; } if($TocFlag>0 && $TocTopFlag>0 && $RtfMode==0) { $toc="$n3<a href='#toc'><img src='/image/toc_up.gif' border='0' height='12' width='12'></a> "; } if($SectionEditing && $headercount) { $iconedit=ScriptIdSectionRetIconLink($ScriptName,$PageCur,$headercount); } if($UseHtmlTitle) { $hnr=7-$size0; if($hnr<1) { $hnr=1; } if($hnr>6) { $hnr=6; } my ($style,$bt,$ft); if($bcol ne '') { $bt=" background:$bcol;" } if($fcol ne '') { $ft=" color:$fcol;" } if($bt ne '' || $ft ne '') { $style=" style=\"$bt$ft\""; } if($iconedit) { $iconedit="<div style=' float:right; '>$iconedit</div>"; } #nok $title="<h$hnr$style><table border='0' cellspacing=0 cellpadding='0' style='border-color:transparent; border:0 0 0 0; margin:0 0 0 0; padding:0 0 0 0;' ><tr><td>$body$toc</td><td>$iconedit</td></tr></table></h$hnr>"; $title="<h$hnr$style>$iconedit$body$toc</h$hnr>"; } else { if($bcol ne '') { $bcol="bgcolor='$bcol'"; } $luft="cellpadding='$luft'"; $size="size='$size'"; if($fcol ne '') { $fcol=" color='$fcol'"; } $title="<table width='100%' $luft border='0' $bcol><tr><td width='95%'><font $size$fcol class='h$size0'>$body$toc</font></td><td align='right' width='5%'>$iconedit</td></tr></table>"; } return "$name1$name2$name3$title"; } sub WikiSmiley { my ($pat)=@_; my $nam; if($RtfMode) { return $pat; } if(($pat eq ":)") || $pat eq ":-)") { $nam="smile"; } elsif($pat eq ":(" || $pat eq ":-(") { $nam="frown"; } elsif($pat eq ";)" || $pat eq ";-)") { $nam="wink"; } elsif($pat eq ":::") { $nam="happy"; } return NameStyleRetImageGif("s_$nam",$LinkTypeIconStyle); }