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("");
} 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("");
$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.="§ion=$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=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§ion=$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);
} |