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

 
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); }