ProWikiCenter: Code/Part8

March 3, 2009

ProWikiCenter

Code /
Part8

Difference (last change) (Author, normal page display)

Deleted: 13,480d12

sub ShowTop {
my (%hash,$text,@tab,$tabn,$page,$i,$ii,$h,$zugriffe,@files,$file);
my $count=RetParam('count',50);
my $days=RetParam('days',4);
my $show=RetParam('show','o');
my $anz=1; # avoid / 0
my ($ts1,$ts2)=DaysRetParamTsRange($days,0);

@files=NameTsRangeRetFiles($LogFile,$ts1,$ts2);
foreach $file (@files) {
$zugriffe += HashAddLogFileTsRange(\%hash,$file,0,$ts1,$ts2);
}

undef $hash{'TopFünfzig'};
foreach $h( ('RecentChanges', 'StartSeite', 'TestSeite', 'SuchFunktionen') ) {
if($show ne 'n') {
DownSize(\$hash{$h});
}
}

@tab=HashRetTabSorted(\%hash);
$tabn=$#tab;

if($show eq 'p') {
for($i=0; $i<$tabn; $i+=2) {
$anz+=$tab[$i+1];
}
}

$count*=2;
if($tabn>$count) {
$tabn=$count;
}

my $titel=Lu("Ordered list|Aktuelle Rangfolge|Liste triée|Lista ordenada");
my $stunden=$days*24;
if($show eq 'n') {
$lb1=Lu("(%COUNT% accesses in %HOURCOUNT% hours, actions filtered)|(%COUNT% Zugriffe aus %HOURCOUNT% Stunden, Aktionen gefiltert)|(%COUNT% accès en %HOURCOUNT% heures, actions filtrées)|(%COUNT% Accesos dentro de %HOURCOUNT% horas, acciones filtrados)");
MessRepVar($lb1,"%COUNT%",$zugriffe,"%HOURCOUNT%",$stunden);
$titel.=" $lb1";
}
$text .= FormTableStart();
$text .= HeaderColSpan($titel,$FormTitlebackground,2);
for($i=0,$ii=1; $i<$tabn; $i+=2,$ii++) {
$page=shift(@tab);
$count=shift(@tab);
if($show eq 'p') {
$count=sprintf("%.2lf\%",100*$count/$anz);
} elsif($show eq 'o') {
$count=$ii . ".";
}
$text .= LineRsLm(" $count ",&PageClassRetLink($page));
}
$text .= FormTableEnd();
$lb1=Lu("Most often accessed pages|Seiten mit den meisten Zugriffen|Pages les plus souvent accédées|Páginas con los más accesos");
ShowTitleTextLinkSearch($lb1,$text,1,1);
}

sub ShowSet {
my $var=RetParam('var','');
my $val=RetParam('val','');
my $id=RetParam('redirect','');
my $wflag;
my $cnam=$ScriptFilename;
$cnam= FileSetExtRet($cnam,".cfg");

my $text=FileRetStr($cnam);
if($var ne && $val ne ) {
$wflag=1;
if($VarLockedHash{$var} ne '') {
$lb1=LiError();
$lb2=Lu("Variable %NAME% can't be changed.|Variable %NAME% kann nicht geändert werden.|Variable %NAME% ne peut être modifiée.|Variable %NAME% no puede ser cambiado.");
MessRepVar($lb2,"%NAME%",$var);
MessNormalTitleText($lb1,$lb2);
return;
}
$val =~ s/"/"/g; # Unquote common URL HTML
if($val eq '""') {
$text =~ s/(^|\n)$var=(.*)(\n|$)/\n/g;
} else {
if($text =~ s/(^|\n)$var=(.*)(\n|$)/$1$var=$val$3/) {
#ok
} else {
$text .= "\n$var=$val\n";
}
}
$text =~ s/\n+/\n/g;
FileSetStr($cnam,$text);
}
$text =~ s/\n/$br/g;

if($id ne '' && $wflag>0) {
ReBrowsePage($id);
} else {
ShowTitleTextLinkSearch(Lu("Configuration data|Konfigurationsdaten|Donnée configuration|Datos configuración"),$text,1,1);
}
}

sub SisterPackRemove {
my ($fnam,$pack,$remove)=@_;
my $text=FileRetStr($fnam);
my @lines=reverse split(/\n/,$text);
my %rhash=ListSplitHash($remove);
my (@out,%dup,$line,$write,$text2);

foreach $line (@lines) {
if(++$dup{$line}<=1) {
$write=1;
if($line=~m/.(.*?)($|

/) {
if($rhash{$1}) {
$write=0;
}
}
if($write) {
push(@out,$line);
}
}
}
$text2=join("\n",reverse @out)."\n";
if($text2 ne $text) {
FileSetStr($fnam,$text2);
}
}

sub ShowSisters {
my $var=RetParam('var','');
my $pack=RetParam('pack','');
my $remove=RetParam('remove','');
my ($text,@files,$count,$fnam);

ArrayAddFilesDirSpec(\@files,"$GlobalDir/sister","^(.*\.lsi)\$");
$count=@files;
foreach $fnam (@files) {
SisterPackRemove($fnam,$pack,$remove);
}

$text.="\n\nSister pages: $count";
$text=~s/\n/$br/g;

ShowTitleTextLinkSearch(Lu("Sister Sites"),$text,1,1);
}

sub ShowVoting {
my ($id)=@_;
my $vote=RetParam('vote','');
my $fnam=PageRetFileName($id)."/Log.dw";
my ($line);
my $text=$br.Lu("Thank you for voting.|Danke für die Teilnahme an der Abstimmung.|Merci d'avoir voté.|Muchas gracias por votar.").$br.$br.
ActionLabelClassIdTargetTitleRetLink($id,LiContinue(),'body',$id) . $br.$br;
my $ts=$^T;
my $tm=TimeRetLog($ts);
$line="vote=$vote|time=$ts/$tm|IP=$UserIP|USER=$UserPref($UserName)\n";
FileAppStr($fnam,$line);
ShowTitleTextLinkSearch(Lu("Voting|Wahlbestätigung"),$text,1,1); # FIXME fr,es,other
}

sub ShowRandom {
my $count=RetParam('count',1);
my $menu=RetParam('menu','');
my @pages = WikiRetPageList();
my (@ar,$dim,$i,$ind);

if($count<=1) {
$dim=@pages;
my $id=$pages[int(rand($dim))];
ReBrowsePage($id,"");
return;
}
ArrayRandomize(\@pages);
$dim=@pages;
@pages=@pages[0..$count-1];
$MultiLinking=0;
$WikiAutoEditLink=0;
if($menu) {
$PageAutoTalk=0;
}
my $text=PageListRetHtml(,$ScriptName,\@pages,undef,LiFound(),,0,'',0,undef,0,0,undef,undef,$PageAutoTalk);
ShowTitleTextLinkSearch(Lu("Random Pages|Zufallsseiten"),$text,1,1); # FIXME fr,es,other
}

sub StrStripCdml {
my ($s,$head)=@_;
my ($n,$slen,$i,$c,$hlen,$cstart);
$hlen=length($head);

FRAME:
while($s =~ /\[\[$head\]/g ) {
$n=1;
$slen=length($s);
$cstart=pos($s)-$hlen-3;
for($i=pos($s); $i<$slen; $i++) {
$c=substr($s,$i,1);
if($c eq ']') {
$n--;
if($n==0) {
substr($s,$cstart,$i+1-$cstart)="";
next FRAME;
}
} elsif($c eq '[') {
$n++;
}
}
}
return $s;
}

sub NameCvtBlanks {
my ($name)=@_;
$name =~ s/ /$SpaceReplacement/g;
return $name;
}

sub TextStripNoLink {
my ($p text)=@_;
$$p text =~ s#((.|\n)*?)# #ige;
$$p text =~ s#$InterWebPattern# #ige;
$$p text = StrStripCdml($$p text,'Code');
}

sub HashPageAddWanted {
my ($h hash,$mp,$begging,$name)=@_;

if($begging =~ m#^$WordPattern\/#) {
return;
}
if($begging =~ m#^/#) {
$begging=$mp.$begging;
}
$$h hash{$begging}++;
}

sub ShowBegging {
my @pages= WikiRetPageList();
my ($mp,$name,%wanted,$text,$pgt,$action,$sub,$leaf);

%wanted=();

LOOP:
foreach $name (@pages) {
$leaf=PageRetLeaf($name);
if($leaf eq $ContextPageName) {
next LOOP;
}
$pgt=PageRetText($name);
$mp=PageRetTop($name);
if($mp eq '') {
$mp=$name;
}
TextStripNoLink(\$pgt);
if($FreeLinks) {
$pgt =~ s/{{$FreePattern}}/&HashPageAddWanted(\%wanted,$mp,&NameCvtBlanks($1),$name)/ge;
}
$pgt=~ s/(^|$SepLetter)$WikiPattern/&HashPageAddWanted(\%wanted,$mp,$2,$name)/ge;
}
foreach $name (@pages) {
delete $wanted{$name};
}
my @ktab=sort keys %wanted;
my $anz=($#ktab + 1);
$text= "<h2>" . SiteAnzRetSeiten('',$anz,LiFound()) . "</h2>\n";

my (@stab,$n,$w,$line);

foreach $name (@ktab) {
$n=$wanted{$name};
push(@stab, sprintf("%06d",100000-$n).";$name;$n" );
}
@ktab=sort @stab;

$text .= FormTableStart();
$text .= LineRsLmCol(Lu("Found|Fundstellen||Lugares del hallazgo"),Lu("Links|Links||Enlaces"),$FormTitlebackground);
foreach $line (@ktab) {
($n,$name,$w)=split(";",$line);
($mp,$sub)=PageRetTopSub($name);
if($mp eq '') {
$action="search=$name&title=off&word=on&case=on";
} else {
$action="search=/$sub&title=off&word=on&case=on&mp=$mp";
}
$text .= LineRsLm(
ActionLabelClassIdTargetTitleRetLink($action,$w."x","body").$n1,
$name . PageLabelClassRetEditLink($name,"?","body",$name)
);

}
$text .= FormTableEnd();

ShowTitleTextLinkSearch(Lu("Begging pages|Verlangte Seiten|Demande de pages en cours|Páginas requeridas"),$text,1,1);
}

sub ShowTextAll {
my @pages=WikiRetPageList();
my $id;

print "Content-type: text/plain\n\n";
foreach $id (@pages) {
print "=======$id=======\n";
print PageRetText($id),"\n";
}
}

sub PagesRetHtml {
my (@pages)=@_;
my ($id,$label,$text,$text2,@ar);

foreach $id (@pages) {
$label=PageRetLabel($id);
$PageCur=$id;
$PageTop=$id;
$PageTop =~ s|/.*||; # remove subpage

$text2="$br$br<hr><hr>$br<h2>$label</h2>\n";
$text=PageRetHtml($id);
$text2.=$text;
$text2.=PageRetFolderList($id,PageRetTextFast($id));
push(@ar,$text2);
}
return join('',@ar);
}

sub ShowPagesAll {
my @pages=WikiRetPageList();

my $filter=RetParam('filter','');
my $select=RetParam('select','');
if($filter ne '') {
@pages=ArrayStrFilterRegex(\@pages,$filter,1);
}
if($select ne '') {
@pages=ArrayStrFilterRegex(\@pages,$select,0);
}

my $text=PagesRetHtml(@pages);
$lb1=Lu("All Pages - %WIKINAME%|Alle Seiten - %WIKINAME%|Toutes les Pages - %WIKINAME%|Todas las páginas - %WIKINAME%");
MessRepVar($lb1,"%WIKINAME%",$SiteName);
ShowTitleText($lb1,$text);
}

sub ShowDocument {
my $id=RetParam('id','');
my $name=RetParam('name','');
my (%hlevel,%hlabel,@pages);
if(PageExist($id)) {
@pages=PageCdmlNameGetLevelLabelRetPages($id,'(?:Dokument|document)',$name,\%hlevel,\%hlabel);
}
my $text=PagesRetHtml(@pages);
ShowTitleText(Lu("Document |Dokument |Document |Documento ")."$id - $name",$text);
}

sub TextReduceWords {
my ($text)=@_;
$text =~ s/[Š]//g;
$text =~ s/$UrlPattern/ /g;
$text =~ s/(^|$SepLetter)$WikiPatternRef/$1 /g;
$text =~ s#[\[=]$AnyLetter*[\]=]# #g;
$text= StrStripCdml($text,'Code');
$text =~ s/["']/ /g;
return $text;
}

sub ShowWordsAll {
my @pages=WikiRetPageList();
my $id;
my $text;
my %hash;

print "Content-type: text/plain\n\n";
foreach $id (@pages) {
$text=PageRetText($id);
$text=TextReduceWords($text);
$text =~ s/([A-ZÄÖÜ]?[a-zäöüß]+)/$hash{$1}=1/ge;
}
print join("\n",sort keys %hash),"\n";
}

sub PageArrayRetFormSpellCheck {
my ($id,@ar)=@_;
my ($ret,$word,$word2,$de,$en,$fw,$nm);

if($#ar<0) {
return Lu("No unknown words found.|Keine unbekannten Wörter gefunden.|Pas de mots inconnus trouvés.|Palabras desconocidas no fueron encontradas.");
}
$de=Lu(" (German dictionary)| (Deutsches Wörterbuch)| (Dictionaire allemand)| (Diccionario alemán)");
$en=Lu(" (English dictionary)| (Englisches Wörterbuch)| (Dictionaire anglais)| (Diccionario inglés)");
$fw=Lu(" (technical dictionary)| (Fachwörterbuch)| (dictionnaire technique)| (Diccionario técnico)");
$nm=Lu(" (Names)| (Eigenname/Sonstiges)| (Noms)| (Nombres)");

$ret = FormStart("form rsk",$id);
$ret .= FormNameValueHidden("cur page",$id) . "\n";
foreach $word (@ar) {
$word2=WordTogCase($word);
if($WikiLanguage==1) {
$ret .= FormCheck("de_$word",0,"$word$de") . $br;
$ret .= HtmlLuft(20,1);
$ret .= FormCheck("de_$word2",0,"$word2$de") . $br;
$ret .= HtmlLuft(20,1);
}

$ret .= FormCheck("en_$word",0,"$word$en") . $br;
$ret .= HtmlLuft(20,1) . FormCheck("en_$word2",0,"$word2$en") . $br;
$ret .= HtmlLuft(20,1) . FormCheck("fw_$word",0,"$word$fw") . $br;
$ret .= HtmlLuft(20,1) . FormCheck("fw_$word2",0,"$word2$fw") . $br;
$ret .= HtmlLuft(20,1) . FormCheck("xx_$word",0,"$word$nm") . $br;
$ret .= HtmlLuft(20,1) . FormCheck("xx_$word2",0,"$word2$nm") . $br;
$ret .= $br;
}
$ret .= FormButton('do',Lu("Add to the dictionaries|In die Wörterbucher einfügen|Ajouter aux dictionnaires|Añadir a los diccionarios")) ;
$ret .= FormEnd();
return $ret;
}

sub DictLoadAll {
KnowFileGetHashPtr("$GlobalDir/dict_de.xw",\%dict de);
KnowFileGetHashPtr("$GlobalDir/dict_en.xw",\%dict en);
KnowFileGetHashPtr("$GlobalDir/dict_fw.xw",\%dict fw);
KnowFileGetHashPtr("$GlobalDir/dict_xx.xw",\%dict xx);
}

sub DictSaveAll {
KnowFileSetHashPtr("$GlobalDir/dict_de.xw",\%dict de);
KnowFileSetHashPtr("$GlobalDir/dict_en.xw",\%dict en);
KnowFileSetHashPtr("$GlobalDir/dict_fw.xw",\%dict fw);
KnowFileSetHashPtr("$GlobalDir/dict_xx.xw",\%dict xx);
}

sub ShowFormSpellCheck {
my ($id)=@_;
my $text=PageRetText($id);
my (%hash,$w2,$title);

DictLoadAll();

$text=TextReduceWords($text);
$text =~ s/([\^.!?:*]?)\s*([A-ZÄÖÜ]?[a-zäöüß]+)/{
$w2=WordTogCase($2);
if( ($dict de{$2} eq "") && ($dict de{$w2} eq "")
&& ($dict en{$2} eq "") && ($dict en{$w2} eq "")
&& ($dict fw{$2} eq "") && ($dict fw{$w2} eq "")
&& ($dict xx{$2} eq "") && ($dict xx{$w2} eq "")
&& ($hash{$2} eq "") && ($hash{$w2} eq "")
)
{
$hash{$2}=1;
}
}/ge;

my $form=PageArrayRetFormSpellCheck($id,sort keys %hash);
$title=Lu("Unknown words on page %PAGENAME%|Unbekannte Wörter in %PAGENAME%|Mots inconnus sur page %PAGENAME%|Palabras desconocidas en página %PAGENAME%");
MessRepPagename($title,$id);
ShowTitleTextLinkSearch($title,$form,1,1);
}

sub PreArrayRetDict {
my ($pre,@ar)=@_;
my ($ret,$word);
my $short = RetParam("short","");

foreach $word (@ar) {
$ret .= "<input type='checkbox' name='$pre$word' value='on'>$word";
if($short) {
$ret .= "$n3 ";
} else {
$ret .= $br;
}
}
return $ret;
}

Changed: 483,2668c15

[[code]

sub ShowFormDict {
DictLoadAll();
my ($form,@ktab);
$form.=FormStart("form dict",'');

if($WikiLanguage==1) {
@ktab=sort keys %dict de;
$lb1=Lu("German dictionary|Deutsches Wörterbuch|Dictionaire allemand|Diccionario alemán");
$form.="<h2>$lb1 (". (1+$#ktab) . "):</h2>\n";
$form.=PreArrayRetDict("de_",@ktab);
}

@ktab=sort keys %dict en;
$lb1=Lu('English dictionary|Englisches Wörterbuch|Dictionnaire anglias|Diccionario inglés');
$form.="<h2>$lb1 (". (1+$#ktab) . "):</h2>\n";
$form.=PreArrayRetDict("en_",@ktab);

@ktab=sort keys %dict fw;
$lb1=Lu('Special dictionary|Fachwörterbuch|Dictionnaire spécial|Diccionario técnico');
$form.="<h2>$lb1 (". (1+$#ktab) . "):</h2>\n";
$form.=PreArrayRetDict("fw_",@ktab);

@ktab=sort keys %dict xx;
$lb1=Lu('Names|Eigennamen/Sonstiges|Noms|Nombres');
$form.="<h2>$lb1 (". (1+$#ktab) . "):</h2>\n";
$form.=PreArrayRetDict("xx_",@ktab);

$form.= $br.$br;
$form.= FormButton('do',Lu('Delete marked words|Markierte Wörter löschen|Effacement des mots marqués|Tachar palabras marcados')) ;
$form.= FormEnd();
ShowTitleTextLinkSearch(Lu('Dictionary|Wörterbuch|Dictionnaire|Diccionario'),$form,1,1);
}

sub ShowFormSpellCheckAnswer {
my $id = RetParam("cur page","");

DictLoadAll();

my $var;
my @plist=$cgi->param();
foreach $var (@plist) {
if($var =~ m/^de_(.*)/) {
$dict de{$1}="1";
}
if($var =~ m/^en_(.*)/) {
$dict en{$1}="1";
}
if($var =~ m/^fw_(.*)/) {
$dict fw{$1}="1";
}
if($var =~ m/^xx_(.*)/) {
$dict xx{$1}="1";
}
}

### DictLock();
DictSaveAll();
### DictUnlock();

ReBrowsePage($id,"");
}

sub ShowFormDictAnswer {
DictLoadAll();

my $var;
my @plist=$cgi->param();
foreach $var (@plist) {
if($var =~ m/^de_(.*)/) {
delete $dict de{$1};
}
if($var =~ m/^en_(.*)/) {
delete $dict en{$1};
}
if($var =~ m/^fw_(.*)/) {
delete $dict fw{$1};
}
if($var =~ m/^xx_(.*)/) {
delete $dict xx{$1};
}
}

### DictLock();
DictSaveAll();
### DictUnlock();

ShowFormDict();
}

sub PageRetResultsHtml {
my ($id, $type)=@_; #type=all,user,top,global
my $fnam="$DataDir

/rslog";
my ($ret,$IN,$line,%data,$name,$result,%ubest,@full,$show,$old date,$date);
my ($ts,$hhmm,$sub,$user,$rhost);

if(!open($IN,"<$fnam")) {
goto do ret;
}
my $filedata=<$IN>;
close($IN);

my @full1 = split(/\n/, $filedata);

if($type eq 'user') {
$sub=LiUser() . ": $UserPref";
} elsif($type eq 'page') {
$lb1=Lu("Test: %PAGENAME%|Fragebogen: %PAGENAME%|Questionnaire : %PAGENAME%|Cuestionario: %PAGENAME%");
MessRepPagename($lb1,$id);
$sub.=$lb1;
} elsif($type eq 'global') {
$sub .= Lu("All users and all tests|Alle Benutzer und alle Fragebögen|Total résultats|Todos usuarios y cuestionarios");
} elsif($type eq 'top') {
$sub .= Lu("Top results|Top-Ergebnisse|Top résultats|Resultados más altos")." ".$id;
}
$ret .= "$br$sub$br$br";

foreach $line (@full1) {
%data = split(/$FS3/,$line);
$show=0;
if($type eq "global") {
$show=1;
} elsif($type eq "user") {
$user=$data{user};
$rhost=$data{rhost};
if(defined($user) && ($UserPref eq $user)) {
$show=1;
}
if(defined($rhost) && ($UserHost eq $rhost)) {
$show=1;
}
} elsif($id eq $data{id}) {
$show=1;
}
if($show) {
push(@full,$line);
}
}

if($type eq 'top') {
my (%rhash, %dhash, $unam, $ures, $o);
foreach $line (@full) { # only best of user
%data = split(/$FS3/,$line);
$unam = $data{user};
$ures = $data{result};
if($ures > $rhash{$unam}) {
$rhash{$unam}=$ures; $o=sprintf("%5.1f",$ures);
$dhash{$unam}="order$FS3$o$FS3$line";
}
}
@full=reverse sort values(%dhash);
} else {
@full= reverse @full;
}

foreach $line (@full) {
%data = split(/$FS3/,$line);
$name = $data{user};
if($name eq '') {
$name = $data{rhost};
}
$result = $data{result};
$id = $data{id};

$ts=$data{time};
$date=TimeRetDay($ts);
if(($type eq "global") || ($type eq "page") || ($type eq "user")) {
if($date ne $old date) {
$old date=$date;
$ret .= "<p><strong>" . $date . "</strong></p>\n";
}
}
$hhmm=TimeRetHour($ts);
if($type eq "global") {
$ret .= "$id: $result%, " . $hhmm . " $name$br";
} elsif($type eq "page") {
$ret .= "$result% $name ($hhmm)$br";
} elsif($type eq "user") {
$ret .= "$id: $result% " . TimeRetText($ts) . $br;
} elsif($type eq "top") {
$ret .= "$result% $name, " . TimeRetText($ts) . $br;
} else { #???
$ret .= "$id: $result% $name, " . TimeRetText($ts) . $br;
}
}
$ret .= $br;
return $ret;
}

sub ShowResults {
my ($id,$type)=@_;
my $text=PageRetResultsHtml($id,$type);
ShowTitleTextLinkSearch(LiResults(),$text,1,1);
}

sub WikiRetFormFileDelete {
my $ret;
$ret .= FormStart("form upload delete",'');
$ret .= FormTableStart();
$ret .= HeaderColSpan(Lu('Delete files|Löschen von Dateien|Effacer fichiers|Tachar ficheros'),$FormTitlebackground,2);
$lb1=Lu('File|Datei|Fichiers');
$ret .= Line("$lb1 1:", FormText('d file1','',25));
$ret .= Line("$lb1 2:", FormText('d file2','',25));
$ret .= Line("$lb1 3:", FormText('d file3','',25));
$lb1=Lu('Delete...|Löschen...|Effacer...|Tachar...');
$ret .= Line($n1, FormButton('do',$lb1));
$ret .= FormTableEnd();
$ret .= FormEnd();
return $ret;
}

sub WikiRetFormFileRename {
my $ret;
$ret .= FormStart("form upload rename",'');
$ret .= FormTableStart();
$ret .= HeaderColSpan(Lu('Rename files|Umbenennen von Dateien|Change le nom de fichiers|Cambiar de nombre de ficheros'),$FormTitlebackground,3);
$lb1=Lu('File|Datei|Fichiers');
$ret .= LineVar("$lb1 1:", FormText('d file1',,25), FormText('d dfile1',,25));
$ret .= LineVar("$lb1 2:", FormText('d file2',,25), FormText('d dfile2',,25));
$ret .= LineVar("$lb1 3:", FormText('d file3',,25), FormText('d dfile3',,25));
$lb1=Lu('Rename...|Umbenennen...|Change...|Cambiar...');
$ret .= LineVar($n1,FormButton('do',$lb1),$n1);
$ret .= FormTableEnd();
$ret .= FormEnd();
return $ret;
}

sub WikiRetFormUpload {
my ($id)=@_;
my ($ret,$types,$i);
my $count=RetParam('count',3);

# $ret .= '<form method="POST" action="cgi-bin/upload.pl" ENCTYPE="multipart/form-data">'
$ret .= $cgi->startform("POST","$ScriptName","multipart/form-data");
$ret .= FormNameValueHidden("form upload",1) . FormNameValueHidden('action',"form upload") . FormNameValueHidden("lang",$WikiLanguage) . "\n";
if($id ne '') {
$ret .= FormNameValueHidden("id target",$id) . "\n";
}

$ret .= FormTableStart();
$ret .= HeaderColSpan(Lu('File upload|Upload von Dateien|Téléversement de fichier|Subir de ficheros'),$FormTitlebackground,2);
$lb1=Lu('File|Datei|Fichier ');
for($i=1; $i<=$count; $i++) {
$ret.=Line("$lb1 ".$i.LiColon(), FormFile('p file'.$i));
# $ret .= Line("$lb1 1:", FormFile('p file1'));
# $ret .= Line("$lb1 2:", FormFile('p file2'));
# $ret .= Line("$lb1 3:", FormFile('p file3'));
}
$lb1=Lu('Do the upload...|Upload durchführen...|Faites le téléversement...|Subir...');
$ret .= Line($n1, FormButton('do',$lb1));
$ret .= FormTableEnd();
$ret .= FormEnd();

$lb1=Lu('allowed file extensions|zugelassene Dateitypen|extensions de fichier autorisées|tipos de ficheros permitidos');
$types=join(" ",sort(keys(%UploadExtTab)));
$types=~ s/\.//g;
$ret .= $br."$lb1: $types". $br;

return $ret;
}

sub DirRetSize {
my ($dir)=@_;
my $totsize;
DirRetFileListGetSize($dir,\$totsize);
return $totsize;
}

sub HashVarRetSum {
my ($h hash,$var)=@_;
my ($sum, $key);
foreach $key (keys(%$h hash)) {
if(($key eq $var) || ($key =~ m/^$var\[/ )) {
$sum += QuotaCalc($$h hash{$key});
}
}
return $sum;
}

sub RetUploadUser {
my $user;
if($CommonUploadDir eq 'y') {
$user=$CookieName;
} else {
$user=$UserName;
}
return $user;
}

sub RetUploadDir {
my $user=RetUploadUser();
my $dir="$UploadBaseDir/$user";
return $dir;
}

sub RetUploadDirErrx {
my $user=RetUploadUser();
$lb1=Lu("Error on upload|Fehler beim Upload|Erreur de téléversement|Error al subir");
if($user eq "") {
$lb2=Lu("For an upload the username must be defined first.|Für ein Upload muss zuerst der Benutzername definiert werden.|Pour un téléversement le nom d'utilisateur doit être défini.|Para subir hay que definir un nombre de usuario primeramente.");
MessNormalTitleText($lb1,$lb2);
}
my $dir=RetUploadDir();
if(!(-d $dir)) {
$lb2=Lu("The upload directory doesn't exist|Upload-Verzeichnis existiert nicht|Le répertoire de téléversement n'existe pas|Directorio de subir no existe");
MessNormalTitleText($lb1,$lb2);
}
return $dir;
}

sub MessRetUploadResults {
my ($mess)=@_;
my $text;
if($mess ne "") {
$lb1=LiResults();
$text .= "$br<h2>$lb1:</h2>\n";
$text .= $mess;
$text .= "$br<hr>$br";
}
return $text;
}

sub ShowFormUploadPage {
my ($mess,$id)=@_;

my $dir=RetUploadDirErrx();
my $text=MessRetUploadResults($mess);

$text.=WikiRetFormUpload($id) . "<hr>$br";
ShowTitleTextLinkSearch(LiUpload(),$text,1,0);
}

sub ShowFormUpload {
my ($mess)=@_;
my (@tab,$elm,$totsize,$quota,$frei,$fnam,$fsize,$ftim,$stime,$link,$url,$label);

my $dir=RetUploadDirErrx();
my $text=MessRetUploadResults($mess);

@tab = DirRetFileListGetSize($dir,\$totsize);

my $user=RetUploadUser();
my %userinfo=UserRetData($user);
$quota= HashVarRetSum(\%userinfo,"UploadLimit");
$frei=$quota-$totsize;
if($frei<0) {
$frei=0;
}
$text .= $br;

$text .= FormTableStart();
$lb1=Lu('Directory|Verzeichnis|Répertoire|Directorio');
$text .= HeaderColSpan("$lb1

Upload:$user",$FormTitlebackground,4);
$text .= LineLsRsLsLmCol(Lu('File|Datei|Fichier|Fichero'),Lu('Size|Größe|Taille|Talla'),Lu('Date|Datum|Date|Fecha'),Lu('Display|Anzeige|Afficher|Despliegue'),$FormTitlebackground);
foreach $elm (@tab) {
($fnam,$fsize,$ftim) = split(';',$elm);
$stime = TimeRetStr($ftim);
$stime =~ s/ / /g;
$url="$UploadUrl/$user/$fnam";
if(NameIsImage($fnam)) {
$lb1=LuNbsp("Display image|Bild anzeigen|Afficher image|Desplegar imagen");
$link= UrlLabelTargetTypeRetLink($url,$lb1,'display');
} else {
$lb1=LuNbsp("Display document|Dokument anzeigen|Afficher document|Desplegar documento");
$link= UrlLabelTypeRetLink($url,$lb1);
}
$text .= LineLsRsLsLm($fnam,$fsize,$stime,$link);
}
if($#tab<0) {
$lb1=LuNbsp("(empty directory)|(leeres Verzeichnis)|(répertoire vide)|(directorio vacío)");
$text .= LineLsRsLsLm($lb1,$n1,$n1,$n1);
}
$lb1=Lu("free upload space: %BYTES%|freier Uploadbereich: %BYTES%|espace de téléversement disponible : %BYTES%|Espacio de subir disponible: %BYTES%");
MessRepVar($lb1,"%BYTES%",QuotaShow($frei));
$lb2=Lu("total|Gesamt|total|total").LiColon().QuotaShow($quota);
$text .= LineLsRsLsLmCol($lb2,$n1.QuotaShow($totsize),$n1,$lb1,$FormTitlebackground);
$text .= FormTableEnd();
$text .= $br;

$lb1=Lu("To use these files on wiki pages type: %TEXT%|Verwendung dieser Dateien in Wiki-Seiten: %TEXT%|Pour utiliser ces fichiers sur les pages wiki : %TEXT%|Para usar estos ficheros en páginas wiki: %TEXT%");
MessRepVar($lb1,"%TEXT%"," Upload:$user/dateiname");
$text .= "$lb1$br$br<hr>$br";
$text .= WikiRetFormUpload() . "<hr>$br";
$text .= WikiRetFormFileDelete() . "<hr>$br";
$text .= WikiRetFormFileRename();

ShowTitleTextLinkSearch(LiUpload(),$text,1,0);
}

sub WikiRetPasswordEntry {
my $ret;
$lb1=LuNbsp('password:|Passwort:|Mot de passe :|Contraseña:');
$lb2=Lu("at least %CHARMIN% characters containing at least %DIGITMIN% digits|mindestens %CHARMIN% Zeichen, davon mindestens %DIGITMIN% Ziffern|au moins %CHARMIN% caractères contenant au moins %DIGITMIN% chiffres|por lo menos %CHARMIN% characteres, de esos %DIGITMIN% cifros");
MessRepVar($lb2,"%CHARMIN%",$PasswordCharMin,"%DIGITMIN%",$PasswordDigitMin);

$ret .= Line($lb1, FormPassword('p password1','') . " ($lb2)");
$lb2=Lu('confirm|Kontrolleingabe|confirmation|confirmación');
$ret .= Line($lb1, FormPassword('p password2','') . " ($lb2)");
return $ret;
}

sub QuotaCalc {
my ($s)=@_;
my $ret=0+$s;
if($s=~ m#([kK])#) {
$ret*=1024;
} elsif($s=~ m#([mM])#) {
$ret*=1024*1024;
}
return $ret;
}

sub QuotaShow {
my ($s)=@_;
my $ret=QuotaCalc($s);
my $c;
if($ret>=1024*1024) {
$ret/=1024.0*1024.0; $c='MB';
} elsif($ret>=1024) {
$ret/=1024.0; $c='KB';
}
$ret=sprintf("%.2lf",$ret);
$ret=~s/\.00$//;
$ret=~s/\.0$//;
return "$ret $c";
}

sub WikiRetFormAddUser {
my $ret;
my $qdef=QuotaShow($UploadUserQuotaDefault);
my $qmax=QuotaShow($UploadUserQuotaMax);

$ret .= FormStart("form admin add user",'');
$lb1=Lu("Create a new user|Einen neuen Benutzer anlegen|Créer un nouvel utilisateur|Crear un nuevo usuario");
$ret .= "<h2>$lb1:</h2>\n";
$ret .= FormTableStart();
$ret .= Line(LuNbsp('username:|Benutzername:|Nom utilisateur :|Nombre de usuario:'), FormText('p username','',25) . LiUsernameExample());
$ret .= WikiRetPasswordEntry();
$lb1=LuNbsp('User rights:|Benutzerstatus:|Droits utilisateur :|Estado de usuario:');
my @ar=WikiRetStatusTab();
$ret .= Line($lb1, FormSelect('p userstate',LiAuthor(),@ar));
$lb1=LuNbsp("Upload quota:|Upload-Quota:|Quota :|Cuota:");
$ret .= Line($lb1, FormText('p uploadquota',$qdef,12) . " (0..$qmax)");
$ret .= Line($n1, FormButton('do',Lu("Create user|Benutzer anlegen|Créér utilisateur|Crear usuario")));
$ret .= FormTableEnd();
$ret .= FormEnd();

return $ret;
}

sub WikiRetFormChangeUser {
my ($ret,$un cur,$us cur,$uq cur);
my $qmax=QuotaShow($UploadUserQuotaMax);
my $qcur=QuotaShow($FormUserQuota);
if($qcur==0) {
$qcur="";
}

$ret .= FormStart("form admin change user",'');

$lb1=Lu("Change user rights|Benutzerrechte ändern|Modifier droits utilisateur|Cambiar estado de usuario");
$ret .= "<h2>$lb1:</h2>\n";

$ret .= FormTableStart();

$lb1=LuNbsp("username|Benutzername|Nom utilisateur |Nombre de usuario");
$ret .= Line(" $lb1:", $cgi->textfield(-name=>'c username', -size=>25, -maxlength=>50));

$lb1=Lu("Show user rights|Benutzerrechte anzeigen|Afficher droits utilisateur|Desplegar estado de usuario");
$ret .= Line($n1, FormButton('b show',$lb1));

my @ar=WikiRetStatusTab();
$lb1=LuNbsp('User rights:|Benutzerstatus:|Droits utilisateurs :|Estado de usuario:');
$ret .= Line($lb1, FormSelect('c userstate',$FormUserStatus," ",@ar));
$lb1=LuNbsp("Upload quota:|Upload-Quota:|Quota :|Cuota:");
$ret .= Line($lb1, FormText('c uploadquota',$qcur,12) . " (0..$qmax)");
$ret .= Line($n1, FormButton('b change',Lu("Change user rights|Benutzerrechte ändern|Changer droits utilisateur|Cambiar estado de usuario")));
$ret .= FormTableEnd();

$ret .= FormEnd();
return $ret;
}

sub ShowFormAdmin {
my ($mess)=@_;
my ($text,$all);

if($mess ne "") {
$lb1=Lu("results|Resultate|résultats|Resultados");
$text .= "$br<h2>$lb1:</h2>\n";
$text .= $mess;
$text .= "$br<hr>$br";
}
if($UserName eq $ProgrammerName) {
if(RetParam('show') eq 'all') {
$all=1;
}
}

my @ulist = DirRetUserList("$GlobalDir/user",1,$all);

$lb1=Lu("List of registered users|Liste der registrierten Benutzer|Liste des utilisateurs enregistrés|Lista de usuarios registrados");
$text .= "$br<h2>$lb1".LiColon()."</h2>\n";
$text .= join($br, @ulist);
$text .= "$br$br\n<hr>$br";

$text .= WikiRetFormAddUser();
$text .= "<hr>$br";
$text .= WikiRetFormChangeUser();
# $text .= "<hr>$br";
# $text .= WikiRetFormDelUser();
$lb1=Lu("User management|Benutzerverwaltung|Organisation utilisateur|Administración usuarios");
$lb2=Lu("used by %USERNAME%|benutzt von %USERNAME%|utilisé par %USERNAME%|usado por %USERNAME%");
MessRepVar($lb2,"%USERNAME%",$UserName);
$PageTitleComment="($lb2)";
ShowTitleTextLinkSearch("$lb1",$text,1,0);
}

sub WikiRetFormUserData {
my ($ret,$f);
my $email= $GlobalUserData{'EmailAddress'};
my $wgroup=$GlobalUserData{'WikiGroup'};
my $nea = $GlobalUserData{'NotificationEmailAddress'};;
my $nwl = $GlobalUserData{'NotificationWikiList'};;
my $ntl = $GlobalUserData{'NotificationTimeList'};;

$ret .= FormStart("form user data",'');
$ret .= FormTableStart();
$lb1=Lu("User data|Benutzerdaten|Donnée utilisateur|Datos usuario");
$ret .= HeaderColSpan($lb1,$FormTitlebackground,2);
$lb1=LuNbsp("username:|Benutzername:|Nom utilisateur :|Nombre de usuario:");
$ret .= Line("$lb1 ",$UserName.$n1);
$lb1=LuNbsp("E-mail address:|e-Mail Adresse:|Adresse e-mail :|Dirección e-mail:");
$ret .= Line("$lb1 ",FormText('c email',$email,40));
$lb1=LuNbsp("Wikis (for global functions):|Wikis (für globale Funktionen):|Wikis (pour fonctions générales) :|Wikis (por funciones generales):");
$ret .= LineTop("$lb1 ",FormTextArea('c wgroup',$wgroup,5,40,1,0));
$lb1=Lu("Notification|Benachrichtigung|Notification|Notificación");
$ret .= HeaderColSpan($lb1,$FormTitlebackground,2);
$lb1=LuNbsp("E-mail address:|e-Mail Adresse:|Adresse e-mail :|Dirección e-mail:");
$ret .= Line("$lb1 ",FormText('c nea',$nea,40));
$lb1=LuNbsp("Wikis:|Wikis:|Wikis :|Wikis:");
$ret .= LineTop("$lb1 ",FormTextArea('c nwl',$nwl,5,40,1,0));
$lb1=LuNbsp("Notification hours (00..23):|Zu folgenden Stunden (00..23):|Notification heures (00..23) :|Notificación horas siguentes(00..23):");
$ret .= Line("$lb1 ",FormText('c ntl',$ntl,40));
$ret .= Line($n1, FormButton('b change',Lu("Change user data|Benutzerdaten ändern|Changer données utilisateur|Cambiar datos usuario")));
$ret .= FormTableEnd();
$ret .= FormEnd();

$ret .= "<hr>$br";

$ret .= FormStart("form user password",'');
$ret .= FormTableStart();
$lb1=Lu("Change password|Passwortänderung|Changer mot de passe|Cambiar contraseña");
$ret .= HeaderColSpan($lb1,$FormTitlebackground,2);
$ret .= WikiRetPasswordEntry();
$ret .= Line($n1, FormButton('b password',Lu('Change password|Passwort ändern|Changer mot de passe|Cambiar contraseña')));
$ret .= FormTableEnd();
$ret .= FormEnd();

return $ret;
}

sub ShowFormUserData {
my $text.=WikiRetFormUserData();
$lb1=Lu("Change your own user data|Eigene Benutzerdaten ändern|Changer vos propres données utilisateur|Cambiar los datos usuario proprios");
ShowTitleTextLinkSearch($lb1,$text,1,0);
}

sub TextAreaClean {
my ($t)=@_;
$t=~ s#\r# #gs;
$t=~ s#\n# #gs;
$t=~ s# +# #gs;
StrStripChrBoth($t,' ');
return $t;
}

sub ShowFormUserDataAnswer {
my $email = RetParam("c email","");
my $wgroup = RetParam("c wgroup","");
my $nea = RetParam("c nea","");
my $nwl = RetParam("c nwl","");
my $ntl = RetParam("c ntl","");
my ($ret,$f);

$wgroup=TextAreaClean($wgroup);
$nwl=TextAreaClean($nwl);

$GlobalUserData{'EmailAddress'}=$email;
$GlobalUserData{'WikiGroup'}=$wgroup;
$GlobalUserData{'NotificationEmailAddress'}=$nea;
$GlobalUserData{'NotificationWikiList'}=$nwl;
$GlobalUserData{'NotificationTimeList'}=$ntl;

UserSetGlobalInfo($UserName,\%GlobalUserData);

$ret.= $br.Lu("The user data have been stored.|Die Benutzerdaten wurden gespeichert.|Les données utilisateurs ont été enregistrées.|Los datos usuario fueron guardados.").$br.$br;

ShowTitleTextLinkSearch(Lu('Storing user data|Speichern der Benutzerdaten|Enregistrement données utilisateur en cours|Guardar datos usuario'),$ret,1,0);
}

sub WikiRetFormLogin {
my $ret;

$ret .= FormStart("form login",'');
$ret .= FormNameValueHidden("old plist",WikiRetParamAllStr($PageReferenced)) . "\n";

$ret .= FormTableStart();
$ret .= HeaderColSpan(Lu('User login form|Benutzeranmeldung|Formulaire de connexion utilisateur|Formulario de entrar'),$FormTitlebackground,2);
$ret .= Line(LuNbsp('Enter your name:|Benutzername:|nom utilisateur :|Nombre de usuario:'), FormText('p username','',25) . LiUsernameExample());
$ret .= Line(LuNbsp('Enter your password:|Passwort:|mot de passe :|Contraseña:'), FormPassword('p password',''));
$ret .= Line($n1, FormButton('do',Lu('Login|Anmelden|Login|Entrar')));
$ret .= FormTableEnd();

$ret .= FormEnd();
return $ret;
}

sub ShowFormLogin {
my $text= WikiRetFormLogin();
ShowTitleTextLinkSearch(Lu("Login|Anmeldung|Login|Entrar"),$text,1,0);
}

sub UploadTarget {
my ($target id)=@_;
my $target text=($target id ne ) ? PageRetTextFast($target id) : ;
my ($cgi,$nr,$path,$file,$ext,$hext,$size,$ret,$app,$quota,$cursize,$fnam,$ers,$apptext,$wrapper,$w,$var);
my $ok=0;

my $dir=RetUploadDirErrx();
my $dirstrip=$dir;
$dirstrip=~ s#^$UploadBaseDir/##;

my $user=RetUploadUser();
my %userinfo=UserRetData($user);

$quota= 1.05 * HashVarRetSum(\%userinfo,"UploadLimit");

do file:
for($nr=1; $nr<=100; $nr++) {
$cgi = new CGI;
$path = $cgi->param("p file$nr");

if($path eq "") {
next do file;
}
$file=PathRetFile($path);
$file =~ s/\s//g;
$ext=PathRetExt($path);
if($file =~ m/ /) {
$lb1=Lu("the file %PATH% couldn't be copied|Die Datei %PATH% konnte nicht kopiert werden|le fichier %PATH% n'a pous être copié|El fichero %PATH% no podría ser copiado");
MessRepVar($lb1,"%PATH%",$path);
$lb2=Lu("(file names may not contain blank characters)|(Leerzeichen in Filenamen sind nicht erlaubt)|(les noms de fichiers ne doivent pas contenir de caractères blancs)|(el nombre del fichero no debe contener caracteres blancos)");
$ret.=LiErrorBold().LiColon()."$lb1 $lb2".LiFullstop().$br;
next do file;
}
if($UploadExtTab{$ext} ne "ok") {
$lb1=Lu("on uploading file %FILE%|Beim Upload von %FILE%|lors du téléversement du fichier %FILE%|subiendo el fichero %FILE%");
MessRepVar($lb1,"%FILE%",$file);
$lb2=Lu("(the extension %EXT% is not allowed)|(der Typ %EXT% ist für den Upload nicht zugelassen)|(l'extension %EXT% n'est pas autorisée)|(No está permitido subir el tipo %EXT%)");
MessRepVar($lb2,"%EXT%",$ext);
$ret.=LiErrorBold().LiColon()."$lb1 $lb2".LiFullstop().$br;
next do file;
}
$fnam="$dir/$file";
# MsgPrint("UPLOAD src FILEHANDLE path=$path");
$size=FileCpy($fnam,$path);
if($size>0) {
$wls=Lu("The file %PATH% (%SIZE% bytes) was copied. ( Usage: %TEXT% )|Die Datei %PATH% (%SIZE% Bytes) wurde kopiert. ( Verwendung: %TEXT% )|Le fichier %PATH% (%SIZE% en bytes) a été copié. ( Usage : %TEXT% )|El fichero %PATH% (%SIZE% bytes) fue copiado. ( Verwendung: %TEXT% )");
MessRepVar($wls,"%PATH%","$path","%SIZE%",$size,"%TEXT%"," Upload:$dirstrip/$file");
$ret.=$wls.$br;
if(!($target text =~ m#$user/$file#)) {
$wrapper='@';
if(NameIsImage($file)) {
$hext=".image";
} else {
$hext=$ext;
}
$var="upload$hext.wrapper";
$w=$Context

{$var};
if($w ne '') {
$wrapper=$w;
}
$wrapper=~ s/\\n/\n/g;
$wrapper=~ s/\\\[/[/g;
$apptext=$wrapper;
$apptext =~ s#(\@\@|\{url\})#$UploadUrl/$user/$file#g;
$apptext =~ s#(\@|\{upload\})#Upload:$user/$file#g;
$app.="\n

\n\n$apptext\n\n";
}
$ok=1;
} else {
$wls=Lu("the file %PATH% couldn't be copied|Die Datei %PATH% konnte nicht kopiert werden|le fichier %PATH% n'a pu être copié|El fichero %PATH% no podría ser copiado");
MessRepVar($wls,"%PATH%","$path");
$ret.=LiErrorBold().LiColon().$wls.LiFullstop().$br;
}
$cursize=DirRetSize($dir);
if($cursize>$quota) {
$wls=Lu("the file %PATH% can't be stored in the upload directory (upload limit exceeded).|Die Datei %PATH% konnte nicht im Upload-Bereich gehalten werden (Upload-Limit überschritten).|le fichier %PATH% ne peut pas être sauvegardé dans le répertoire de téléversement (limite de téléversement dépassée).|El fichero %PATH% no podría ser guardado en el directorio de ficheros subidos (límite sobrepasado).");
MessRepVar($wls,"%PATH%","$path");
$ret.=LiErrorBold().LiColon().$wls.$br;
FileDel($fnam);
}
}
return ($ret,$app,$ok);
}

sub ActionUploadDelete {
my $cgi;
my ($nr,$path,$file,$fnam,$ret);
my $dir=RetUploadDirErrx();

$cgi = new CGI;

do file:
for($nr=1; $nr<=10; $nr++) {
$path = $cgi->param("d file$nr");
if($path eq "") {
next do file;
}
$file=PathRetFile($path);
$fnam="$dir/$file";
if(!(-f $fnam)) {
$wls=Lu("The file %FILE% doesn't exist|Die Datei %FILE% existiert nicht|Le fichier %FILE% n'existe pas|El fichero %FILE% no existe");
MessRepVar($wls,"%FILE%","$file");
$lb2=Lu("(deletion not possible)|(Löschung nicht möglich)|(effacement non possible)|(tachadura no es posible)");
$ret.=$wls.$lb2.LiFullstop().$br;
} else {
FileDel($fnam);
$wls=Lu("The file %FILE% was deleted.|Die Datei %FILE% wurde gelöscht.|Le fichier %FILE% a été effacé.|El fichero %FILE% fue tachado.");
MessRepVar($wls,"%FILE%","$file");
$ret.=$wls.$br;
}
}
return $ret;
}

sub FileNameSupported {
my ($f)=@_;
if($f =~ m/^($AnyLetter|[-_.])*$/) {
return 1;
}
return 0;
}

sub FileCmpLegalRename {
my ($f1,$f2)=@_;
my $e1=StrRetUpper(PathRetExt($f1));
my $e2=StrRetUpper(PathRetExt($f2));
if($e1 ne $e2) {
return 0;
}
return FileNameSupported($f2);
}

sub ActionUploadRename {
my $cgi = new CGI;
my ($nr,$file,$dfile,$ret);
my $dir=RetUploadDir();

do file:
for($nr=1; $nr<=10; $nr++) {
$file = $cgi->param("d file$nr");
$dfile = $cgi->param("d dfile$nr");
if($file eq || $dfile eq || $file eq $dfile) {
next do file;
}
if(!(-f "$dir/$file")) {
$wls=Lu("The file %FILE% doesn't exist|Die Datei %FILE% existiert nicht|Le fichier %FILE% n'existe pas|El fichero %FILE% no existe");
MessRepVar($wls,"%FILE%","$file");
$lb2=Lu("(renaming not possible)|(Umbenennung nicht möglich)|(renommage non possible)|(cambio de nombre no es posible)");
$ret.=$wls." ".$lb2.LiFullstop().$br;
} elsif(-f "$dir/$dfile") {
$wls=Lu("The file %DFILE% already exists|Die Datei %DFILE% existiert bereits|Le fichier %DFILE% existe déjà|El fichero %DFILE% ya existe");
MessRepVar($wls,"%DFILE%","$dfile");
$lb2=Lu("(renaming not possible)|(Umbenennung nicht möglich)|(renommage non possible)|(cambio de nombre no es posible)");
$ret.=$wls." ".$lb2.LiFullstop().$br;
} elsif(FileCmpLegalRename($file,$dfile)==0) {
$wls=Lu("The filename %DFILE% can't be used for renaming.|Der Dateiname %DFILE% kann für die Umbenennung nicht verwendet werden.|Le nom de fichier %DFILE% ne peut pas être utilisé pour être renommé.|El nombre del fichero %DFILE% no puede ser usado para cambio de nombre.");
MessRepVar($wls,"%DFILE%","$dfile");
$ret.=$wls.$br;
} else {
rename("$dir/$file","$dir/$dfile");
$wls=Lu("The file %FILE% was renamed to %DFILE%.|Die Datei %FILE% wurde in %DFILE% umbenannt.|Le fichier %FILE% a été renommé en %DFILE%.|El fichero %FILE% fue cambiado de nombre en %DFILE%.");
MessRepVar($wls,"%FILE%","$file","%DFILE%","$dfile");
$ret.=$wls.$br;
}
}
return $ret;
}

sub GlobalAddWikiUserPasswordStatusQuota {
my ($wikiname,$username,$pw,$status,$quota)=@_;
my $ret=0;
my $fnam= UserNameRetGlobalFileName($username);
my $dnam= PathRetDir($fnam);
my $randkey=RandomRetStamp();
my $content;
my $dir="$UploadBaseDir/$username";

DirCreate($dnam);

$content .= "{Password:$pw}\n";
$content .= "{UserStatus[$CookieName]:$status}\n";
if($quota>0) {
$content .= "{UploadLimit[$CookieName]:$quota}\n";
DirCreate($dir);
}
$content .= "{Check:$randkey}\n";

FileSetStr($fnam,$content);
}

sub DoAddUser() {
my ($ret,$err);
my $unam = $cgi->param("p username");
my $pw1 = $cgi->param("p password1");
my $pw2 = $cgi->param("p password2");
my $us = $cgi->param("p userstate");
my $uq = $cgi->param("p uploadquota");
my $qmax=QuotaCalc($UploadUserQuotaMax);
my ($uqx);

$unam =~ s/ //g;

if( UserNameIsLegal($unam) eq 0) {
$ret .= Lu("The username is invalid. |Der Benutzername ist ungültig. |Le nom utilisateur est invalide. |El nombre de usuario es inválido.");
goto do err;
}
if( GlobalHasUserName($unam) ) {
$ret .= Lu("This username already exists. |Der Benutzername existiert bereits. |Ce nom utilisateur existe déjà. |El nombre de usuario ya existe.");
goto do err;
}

$err=PasswordCheckRetErr($pw1,$pw2);
if($err ne '') {
$ret .= $err;
goto do err;
}

my $si= StatusRetWeight($us);
my $sm= StatusRetWeight($UserStatus);
if( ($si<3) || ($si>=$sm) ) { #Login
$ret .= Lu("Illegal user rights entered.|Unzulässiger Benutzer-Status. |Droits utilisateurs saisis illégaux.|Estado de usuario es inválido.");
goto do err;
}
$uqx=QuotaCalc($uq);
if(($uqx<0) || ($uqx>$qmax)) {
$ret.= Lu("The quota is out of range.|Das Quota ist außerhalb des zulässigen Bereichs.|Le quota est dépassé.|La cuota está fuera de la zona permitida.");
$ret.=" ";
goto do err;
}
my $fret = GlobalAddWikiUserPasswordStatusQuota($CookieName,$unam,$pw1,$us,QuotaShow($uqx));

$lb1=Lu("The user %USERNAME% was created.|Der Benutzer %USERNAME% wurde angelegt.|L'utilisateur %USERNAME% a été créé.|El usuario %USERNAME% fue creado.");
MessRepVar($lb1,"%USERNAME%","$unam");
$ret.=$lb1;

do ret:
$ret.=$br;
return $ret;

do err:
$ret .= Lu("The user was not created.|Der Benutzer wurde nicht angelegt.|L'utilisateur n'a pas été créé.|El usuario $unam no fue creado.") . " ";
goto do ret;
}

sub DoChangeUser() {
my ($ret,$fret);
my $unam=$cgi->param("c username");
my $us=$cgi->param("c userstate");
my $uq=QuotaCalc($cgi->param("c uploadquota"));
my $uqx;
my $qmax=QuotaCalc($UploadUserQuotaMax);
my $show=$cgi->param("b show");
my $change=$cgi->param("b change");
my ($si, $sm, %gi);

$unam =~ s/ //g;

if( UserNameIsLegal($unam) eq 0) {
$ret .= Lu("This username is invalid. |Der Benutzername ist ungültig. |Ce nom utilisateur est invalide. |El nombre de usuario es inválido.");
goto do err;
}
if(! GlobalHasUserName($unam) ) {
$ret .= Lu("This user doesn't exist. |Der Benutzername existiert nicht. |Cet utilisateur n'existe pas. |El nombre de usuario no existe. ");
goto do err;
}
if($change) {
%gi= UserRetGlobalInfo($unam);
if(length($us)>0) {
$si= StatusRetWeight($us);
$sm= StatusRetWeight($UserStatus);
if( ($si<3) || ($si>=$sm) ) { #Login
$ret .= Lu("Illegal user rights given. |Unzulässiger Benutzer-Status. |Droits utilisateur donnés illégaux. |Estado de usuario es inválido. ");
goto do err;
}
$gi{"UserStatus[$CookieName]"} =$us;
}
if(length($uq)>0) {
$uqx = QuotaCalc($uq);
if(($uqx<0) || ($uqx>$qmax)) {
$ret .= Lu("The quota is out of range.|Das Quota ist außerhalb des zulässigen Bereichs.|Le quota est dépassé.|La cuota está fuera de la zona permitida.");
$ret.=' ';
goto do err;
}
$gi{"UploadLimit[$CookieName]"}=QuotaShow($uqx);
}

UserSetGlobalInfo($unam,\%gi); # FIXME: do within a new lock

$wls=Lu("The changes for user %USERNAME% have been saved.|Die Änderungen bei Benutzer %USERNAME% wurden durchgeführt.|Les modifications pour l'utilisateur %USERNAME% ont été sauvegardées.|Las modificaciones para usuario %USERNAME% fueron guardadas.");
MessRepVar($wls,"%USERNAME%","$unam");
$ret.=$wls.$br;
}
%gi = UserRetGlobalInfo($unam);
$FormUserStatus= $gi{"UserStatus[$CookieName]"};
$FormUserQuota= $gi{"UploadLimit[$CookieName]"};

do ret:
return $ret;

do err:
$wls=Lu("The changes have not been saved.|Die Änderungen wurden nicht durchgeführt.|Les modifications n'ont pas été sauvegardées.|Las modificaciones no fueron guardadas.");
$ret.=$wls.$br;
goto do ret;
}

sub WikiPageTextGetVidaHash {
my ($id,$text,$h vd)=@_;
VidaAppTextVar(undef,$h vd,$id,,,,0,$VidaOp,,0,1,$text);
}

sub HashXor { # del identical var.val
my ($h 1,$h 2)=@_;
my ($var);

foreach $var (keys %$h 1) {
if($$h 1{$var} eq $$h 2{$var}) {
delete $$h 1{$var};
delete $$h 2{$var};
}
}
}

sub VidaFilesUpdatePageHash {
my ($type,$id,$h vd)=@_;
my ($var,$val);

foreach $var (keys %$h vd) {
$val=$$h vd{$var};
FileAppStr("$DataDir

/vida/$var.lvd","$type$id $val\n");
if($VidaExportFlag) {
WikiNetExportPageVarVal($type,$id,$var,$val);
}
}
}

sub CacheWrite {
my ($id,$rev,$oldtext,$newtext)=@_;
my ($cs1,$cs2,%vd1,%vd2,$var,$val);

$cs1=WikiTextRetFolderTabStr($oldtext);
$cs2=WikiTextRetFolderTabStr($newtext);
if(($rev<=1) || ($cs2 ne $cs1)) {
FileAppStr("$DataDir

/pagelog","+$id $cs2\n");
}
if($rev<=1) {
if($SisterExportFlag) {
SisterExportPage('+',$id);
}
if($WikiNetExportFlag) {
WikiNetExportPage('+',$id);
}
if($id =~ m/^$WordPattern$/) {
FileAppStr("$DataDir

/wordlog","+$id\n");
}
}
if($VidaCaching

) {
WikiPageTextGetVidaHash($id,$oldtext,\%vd1);
WikiPageTextGetVidaHash($id,$newtext,\%vd2);
HashXor(\%vd1,\%vd2);
DirCreateRecur("$DataDir

/vida",0770);
VidaFilesUpdatePageHash('-',$id,\%vd1);
VidaFilesUpdatePageHash('+',$id,\%vd2);
}
}

sub TextReplaceArrayHash {
my ($text,$a rar,$h val)=@_;
my ($ret,$line,@fields,$write);

foreach $line (split(/\n/,$text)) {
@fields=split(/\|/,$line);
$write=0;
foreach(@$a rar) {
if($fields[$_] ne $$h val{$_}) {
$write=1; # FIXME: opt
}
}
if($write) {
$ret.=$line."\n";
}
}
return $ret;
}

sub PageAppTextLogSummary {
my ($id,$app,$logflag,$summary,$replace,$a rar,$h val)=@_;
my (%page);

my $fnams = PageRetDirectory($id) . "/$id.db";
my $fname = $PageDir . "/" . $fnams;

if(!(-f $fname)) {
$lb1=Lu("Page %PAGENAME% doesn't exist!|Die Seite %PAGENAME% ist nicht vorhanden!|la page %PAGENAME% n'existe pas !|¡La página %PAGENAME% no existe!");
MessRepPagename($lb1,$id);
ShowTitleText(Lu("Error on upload|Fehler beim Upload|Erreur lors du téléversement|Error al subir"),$lb1);
goto do ret;
}

RequestLock();
%page = PageRetHash($id);

my $oldtext=$page{text};
if($replace) {
$oldtext=TextReplaceArrayHash($oldtext,$a rar,$h val);
}
my $newtext=$oldtext.$app;

my $minoredit=0;
my $diff=TextTextRetDiff($oldtext,$newtext);

my $rev=PageSetTextAuthorMinorDiff($id,$newtext,1,$minoredit,$diff);
CacheWrite($id,$rev,$oldtext,$newtext);

if($logflag) {
my $user=RetParam("username","");
my $edittime=time;
RcLogWrite($id,$summary,$minoredit,$edittime,$CookieID,$user,$rev);
}
ReleaseLock();

do ret:
return;
}

sub ShowFormUploadAnswer {
my $idt=RetParam('id target');
my ($mess,$app,$ok)=UploadTarget($idt);
if($idt eq '') {
ShowFormUpload($mess);
return;
}
if($ok) {
PageAppTextLogSummary($idt,$app,1,LiUpload());
ShowPage($idt);
} else {
ShowFormUploadPage($mess,$idt);
}
}

sub ShowFormAddUserAnswer {
my $mess=DoAddUser();
ShowFormAdmin($mess);
}

sub ShowFormChangeUserAnswer {
my $mess=DoChangeUser();
ShowFormAdmin($mess);
}

sub ShowFormUploadDeleteAnswer {
my $mess=ActionUploadDelete();
ShowFormUpload($mess);
}

sub ShowFormUploadRenameAnswer {
my $mess=ActionUploadRename();
ShowFormUpload($mess);
}

sub ShowFormLoginAnswer {
my ($username,$password,$g password,$g check);
my ($text,$action);
my $es=Lu("Login error|Fehler bei der Anmeldung|Erreur de connexion|Error al entrar");

$username = RetParam("p username","");
$username =~ s/ //g;
$password = RetParam("p password","");

if($username eq "") {
$lb1=Lu("no username given|Es wurde kein Benutzername eingegeben|pas de nom d'utilisateur déclaré|Falta nombre de usuario.");
$text .= "$es: $lb1.";
goto do err;
}

if($password eq "") {
$lb1=Lu("no password given|Es wurde kein Passwort eingegeben|pas de mot de passe déclaré|Falta contraseña.");
$text .= "$es: $lb1.";
goto do err;
}

my %global info = UserRetGlobalInfo($username);

$g password = $global info{Password};
$g check = $global info{Check};

if($password ne $g password) {
$lb1=Lu("wrong password|Falsches Passwort|erreur de mot de passe|Contraseña incorrecto");
$text .= "$es: $lb1.$br";
goto do err;
}

$SessionUserName=$username;
$SessionCheck=$g check;
SessionCookieSetNameCheck($SessionUserName,$SessionCheck);

# if($SessionUserName eq '') {
# $lb1=Lu("no Cookie available. Please activate Cookies in your browser software|Kein Cookie vorhanden. Bitte im Browserprogramm Cookies aktivieren|Pas de Cookie disponible. Merci d'activer les Cookies dans votre logiciel de navigation");
# $text .= "$es: $lb1.";
# goto do err;
# }

$text .= "$br<b>";
$lb1=Lu("Login for user %USERNAME% succeeded.|Anmeldung für Benutzer %USERNAME% abgeschlossen.|Connexion utilisateur %USERNAME% réussie.");
MessRepVar($lb1,"%USERNAME%",$username);
$UserName=$username; # partial, just for display
$text.=$lb1.$br.$br;

$action=OldPlistBlockRetAction("action=login");
# MsgPrint("FormLoginAnswer action=$action");
$text.=ActionLabelClassIdTargetTitleRetLink($action,LiContinue(),"body");
$text.="</b>$br$br";

do ret:
ShowTitleTextLinkSearch(Lu("Login results|Resultat der Anmeldung|Résultats de connexion|Resultados de conexión"),$text,1,0);
return;

do err:
$text="$br$text$br$br";
SessionCookieLogout();
goto do ret;
}

sub GetRemoteHost {
my ($rhost, $iaddr);

$rhost = $ENV{REMOTE HOST};
if($rhost eq "") {
# Catch errors (including bad input) without aborting the script
# eval '$iaddr = inet aton($ClientIP);' . '$rhost = gethostbyaddr($iaddr, AF INET)';
}
if($rhost eq "") {
$rhost=$ClientIP;
# $rhost =~ s/\d+$/xxx/; # make more anonymous
}
if($UseCookieID) {
if($CookieID ne '') {
$rhost=$rhost."#".$CookieID;
}
}
return $rhost;
}

sub TextTextRetDiff { # within lock
my ($old,$new)=@_;
my $diff out = "";

StrStripCR($old);
StrStripCR($new);

FileSetStr("$DataDir/d_old",$old);
FileSetStr("$DataDir/d_new",$new);

# my $cmd="diff $DataDir/d_old $DataDir/d_new "; # nok
my $cmd="diff $DataDir/d_old $DataDir/d_new 2>&1"; # Problem: destroys (\n)---\n on changes

$diff out = CmdRetText($cmd);
$diff out =~ s/\<
# $diff out =~ s/\n--+//g; doesn't work because \n missing
$diff out =~ s/(\n<.*)---(\n>

/$1$2/g; # hack for problem above

return $diff out;
}

sub PageStoreTextArchive {
my ($id,$text,$ts,$ip,$host,$pref,$name,$rev)=@_;
my $bnam = $PageDir . "/" . PageRetDirectory($id) . "/$id";
my $fnam = $bnam . ".txt";
my $unam = $bnam . ".usr";
my $comm=join('|','IP'=>$ip,'HOST'=>$host,'PREF'=>$pref,'NAME'=>$name,'TS'=>$ts,'REV'=>$rev);

CreatePageDir($PageDir, $id);

FileSetStr($fnam,$text);
FileSetStr($unam,$comm);

my $cmd="ci -l -x r -f $fnam <$unam 2>&1";
my $result=CmdRetText($cmd);

FileDel($fnam);
FileDel($unam);
}

sub HashPtrLimitRetHtml {
my ($h hash,$limit)=@_;
my ($key,$val,$text);
foreach $key (sort keys %$h hash) {
$val=$$h hash{$key};
if(length($val)>$limit) {
$val="length " . length($val);
}
$text .= "$key=$val$br";
}
return $text;
}

sub ShowEnv {
my $limit=RetParam('limit',128);
my $text=HashPtrLimitRetHtml(\%ENV,$limit);
ShowTitleTextLinkSearch("Environment",$text,1,1);
}

sub LineIndRetField {
return (split(/\|/,$_[0]))[$_[1]];
}

sub LineRetFields {
return split(/\|/,$_[0]);
}

sub HashAddPageVida { # simple
my ($h vida,$id)=@_;
my ($line,$var,$val);
my $text=PageRetTextFast($id);

foreach $line (split(/\n/,$text)) {
if($line =~ m/^[*]+\s*([$AnyLetterList\.]+)\s*[=]\s*([^#]*)/ ) {
$var=$1;
$val=$2;
StrStripBoth($var);
ValStrip($val);
$$h vida{$var}=$val;
}
}
}

sub ShowFormFormAnswer {
my $targetid=RetParam('targetid','');
my $log=RetParam('log','');
my $summary=RetParam('summary','');
my ($text,$errs,@fields,$iline,$lline,$var,$val,$required,$range,%context,%hkeys,%hval,%hind);
my ($fnam,$fline,$lnam,@keys,$keyfields,$replace,@rar);
my $ts=$^T;
my $dts=TimeRetTextGerman($ts);
my $err;
my $iderror;
my $idsuccess;
my $idcontinue;
my $ind=0;

if(PageExist($targetid)==0) {
$errs=Lu("Target page missing|Zielseite fehlt"); $err++;
goto do ret;
}
HashAddPageVida(\%context,"$targetid/$ContextPageName");
$idsuccess=$context{"table.continue.success"};
$iderror=$context{"table.continue.error"};
$keyfields=$context{"table.keyfields"};
@keys=ListSplit($keyfields);
HashAddValKeys(\%hkeys,1,@keys);

$iline=FileRetLineFirst(PageRetFileName($targetid,'.dw'));
StrStripStr($iline,"\n");

foreach $var (LineRetFields($iline)) {
$val=RetParam($var);
StrExistApp($fline,"|");
$fline.=$val;
$lline.="{$var=$val}";
$hval{$ind}=$val;
$hind{$var}=$ind;
if($context{"table.field.required.$var"} || $hkeys{$var} ) {
if($val eq '') {
$err++;
}
}
$ind++;
}
for(@keys) {
$replace++;
push(@rar,$hind{$_});
}
if($err==0) {
$fline.="\n";
PageAppTextLogSummary($targetid,$fline,1,LiForminput(),$replace,\@rar,\%hval);
}
$lline="$ts $lline {_Error=$err}{_Date=$dts}{_UserIP=$UserIP}{_UserName=$UserName}{_UserPref=$UserPref}\n";
$lnam=PageRetFileName("$targetid/Log",'.dw');
FileAppStr($lnam,$lline);

do ret:
if($err) {
$text=LiError().LiColon().$errs;
$idcontinue=$iderror;
} else {
$idcontinue=$idsuccess;
$text=Lu("Input successful|Eingabe erfolgreich")
}
if($idcontinue) {
ShowPage($idcontinue);
} else {
ShowTitleTextLinkSearch(LiForminput(),$text,1,1); # FIXME trans
}
}

sub ShowVarInfo {
my $var=RetParam('var','');
my $text="$var=$$var";
ShowTitleTextLinkSearch(Lu("Display variable|Variablenanzeige|Affichage Variable|Despliegue variable"),$text,1,1);
}

sub NameIsInterWeb {
my ($name)=@_;
if($InterWeb{$name} ne '') {
return 1;
}
if($InterWebSelf{$name} ne '') {
return 1;
}
return 0;
}

sub VidaAppNameText {
my ($a vd,$snam,$text)=@_;
my ($line,$lcount,$pushflag,$app);

foreach $line (split(/\n/,$text)) {
$lcount++;
$pushflag=0;
if($line =~ m/\s*($AnyLetter+)\s*([:=])\s*(.*)$/ ) {
$pushflag++;
if(NameIsInterWeb($2)) {
$pushflag=0;
}
$app="$1|$2|$3|$snam#$lcount";
if($pushflag) {
push(@$a vd,$app);
}
}
}
}

sub VidaAppNameArray {
my $a vd=shift;
my $snam=shift;
my ($var,$val,$lcount,$app);

while (@_) {
$var=shift; $val=shift;
$lcount++;
$app="$var|:|$val|$snam#$lcount";
push(@$a vd,$app);
}
}

sub VidaAppNameKeyVal {
my ($a vd,$snam,$key,$val)=@_;
my $line="$key|:|$val|$snam";
push(@$a vd,$line);
}

sub VidaAppTextVar {
my ($a vd,$h vd,$id,$var,$select,$filter,$context,$op,$pre,$withcomments,$logflag,$text)=@_;
my ($line,$lcount,$pushflag,$app,$val,$help,$vnex,$valid,$valex,@lines,$intro,$leaf);

if($text eq '') {
return;
}

$op="[$op]";
$valex="[$AnyLetterList]+";
$vnex="[$AnyLetterList\$\$]+";

@lines=split(/\n/,$text);
if($VidaAutoIntro ne '') {
$leaf=PageRetLeaf($id);
$intro= (StrExist($lines[0])) ? $lines[0] : $lines[1];
$intro =~ s/^($id|$leaf)\s+//;
$intro =~ s/(?=[.!?]\s+)(.*)$//;
$intro =~ s/\.\s+$//;
if($intro =~ m#\[\[#) {
if(StrFindStrRetCount($intro,"\\[") != StrFindStrRetCount($intro,"\\]")) {
$intro=~ s#\[\[.*$##;
}
}
if($intro =~ m/^$FreeLetter/) {
unshift(@lines,"*$VidaAutoIntro=$intro");
$lcount--;
}
}
foreach $line (@lines) {
$lcount++;
$pushflag=0;

if($line =~ m/^([=])+\s*($valex)\s*(=*)$/ ) {
$valid="($2)";
}
if($line =~ m/^([*])+\s*($pre$vnex)\s*($op)\s*(.*)$/ ) {
$pushflag++;
if($var ne '') {
if( !($2 =~ m/^$pre$var$/) ) {
$pushflag=0;
}
} else {
if(NameIsInterWeb($2)) {
$pushflag=0;
} elsif($2 =~ m/^\d+$/) { # no integers
$pushflag=0;
} elsif($4 =~ m#^//# ) { # no protocols
$pushflag=0;
} elsif($Context

{"vida.suppress.$2"} ne '') {
$pushflag=0;
}
if($VidaVarSelect ne '') {
if(!($2 =~ m/^$VidaVarSelect$/)) {
$pushflag=0;
}
}
if($VidaVarFilter ne '') {
if($2 =~ m/^$VidaVarFilter$/) {
$pushflag=0;
}
}
}
}
$val=$4;
if($withcomments<1) {
$val =~ s/#.*$//;
}
StrStripBoth($val);
$app="$2|$3|$val|$id#$lcount|$valid";
if($pushflag) {
if($select ne '') {
if(!($app =~ m/$select/)) {
$pushflag=0;
}
}
if($filter ne '') {
if($app =~ m/$filter/) {
$pushflag=0;
}
}
}
if($pushflag) {
if($logflag) {
$app=$val;
}
if(defined($a vd)) {
push(@$a vd,$app);
}
if(defined($h vd)) {
$$h vd{$2}=$app;
}
}
}
}

sub VidaAppPageVar {
my ($a vd,$h vd,$id,$var,$select,$filter,$context,$op,$pre,$withcomments,$logflag)=@_;
my $text=PageRetTextFast($id);
return VidaAppTextVar(@_,$text);
}

sub PageRetParents {
my ($id)=@_;
my $i;
my @ar=split(/\//,$id);

pop(@ar);
for($i=1; $i<=$#ar; $i++) {
$ar[$i]=$ar[$i-1].'/'.$ar[$i];
}
return @ar;
}

sub VidaAppPageListPlus {
my ($a vd,$a pages,$parents,$withcomments)=@_;
my ($id,$pre,@parents,$parid);
my $var=RetParam('var','');
my $select=RetParam('select','');
my $filter=RetParam('filter','');
my $op=RetParam('op',':=');
my $context=RetParam('context','');

if($context>0) {
$op="=";
$pre="(?

?:\\d+\\.)?)";
}
foreach $id (@$a pages) {
if($parents>0) {
@parents=PageRetParents($id);
foreach $parid (@parents) {
VidaAppPageVar($a vd,undef,$parid,$var,$select,$filter,$context,$op,$pre,$withcomments,0);
}
}
VidaAppPageVar($a vd,undef,$id,$var,$select,$filter,$context,$op,$pre,$withcomments,0);
}
}

sub VidaRetHtml {
my($a vd)=@_;
my($ret,$line,@el);
foreach $line (@$a vd) {
@el=split(/\|/,$line);
$ret .= "$el[0] $el[1] $el[2] # $el[3]$br";
}
return $ret;
}

sub BodyDistSepRetTable {
my($body,$dist,$sep)=@_;
return "[[table][distance=$dist][separator=$sep]$body]$br0";
}

sub VidaRetWiki {
my($a vd)=@_;
my($ret,$line,$top,$var,$op,$val,$used,$valid,$place,$bcol,$invalid,$body);
my $sep=RetParam('sep','/!/!/');
my $options=RetParam('options','');
my $opflag= ($options =~ m/[oa]/) ? 1 : '';
my $usflag= ($options =~ m/[ua]/) ? 1 : '';
my $vaflag= ($options =~ m/[va]/) ? 1 : '';
my $ivflag= ($options =~ m/[ia]/) ? 1 : '';
my $puflag= ($options =~ m/U/) ? 1 : '';
my $mcflag= ($options =~ m/M/) ? 1 : '';
my $atflag= ($options =~ m/[Aa]/) ? 1 : '';
my $rpflag= ($options =~ m/[Ra]/) ? 1 : '';

if(int(@VidaError)) {
$body = "Fehler@#red\n" . join("\n",@VidaError);
$ret .= BodyDistSepRetTable($body,20,$sep);
}

$ret .= "[[table][distance=20][separator=$sep]";

$ret .= "Variable";
$ret .= "$sep Op" if($opflag);
$ret .= "$sep Value";
$ret .= "$sep Used" if($usflag);
$ret .= "$sep Valid" if($vaflag);
$ret .= "$sep Inv" if($ivflag);
$ret .= "$sep Place\n";

foreach $line (@$a vd) {
($var,$op,$val,$place,$valid)=split(/\|/,$line);

$used = $VidaUsed{$place};
$bcol= ($mcflag ne && $used ne ) ? "@#lightgreen" : '';

if($puflag && ($used eq '')) {
next;
}

$ret .= "$var$bcol";
if($opflag) {
$ret .= "$sep $op";
}
$ret .= "$sep $val$bcol";
if($usflag) {
$ret .= "$sep $used";
}
if($vaflag) {
$ret .= "$sep $valid";
}
if($ivflag) {
$invalid=$VidaInvalid{$place};
$ret .= "$sep $invalid";
}

$top = ($place =~ m/[\$]/) ? '' : "Top:";
$ret .= "$sep $top$place\n";

}
$ret.="]$br0";

if($atflag) {
$body = "Tabelle der wirksamen Atome\n" . join("\n",sort keys %VidaAtomHash);
$ret .= BodyDistSepRetTable($body,20,$sep);
}
if($rpflag) {
$body = "Referer Page\n". WikiRetRefererPage();
$ret .= BodyDistSepRetTable($body,20,$sep);
}

return $ret;
}

sub VidaRetOutput {
my($a vd,$out)=@_;
my ($text);
if($out eq 'html') {
$text=VidaRetHtml($a vd);
} elsif($out eq 'text') {
$text=ArrayRetText($a vd);
} else {
$text=TextWikiRetHtml(VidaRetWiki($a vd));
}
return $text;
}

sub VidaPrint {
if($VidaDebug<1) {
return;
}
my $i=$VidaLevel;
while($i-->0) {
MsgPrintStr(" ");
}
MsgPrint($_[0]);
}

sub MapKeyRetRange {
my ($key)=@_;
my ($lo,$hi);

if($key =~ m/^(.*)\.\.(.*)$/) {
$lo=$1;
$hi=$2;
}
return ($lo,$hi);
}

sub MapKeyEquInd {
my ($key,$ind)=@_;
my $ret=0;

if($key eq $ind) {
$ret=1; goto do ret;
}
if($key =~ m/^(.*)\.\.(.*)$/) {
if($1 eq '' && $ind<=$2) {
$ret=1; goto do ret;
} elsif($2 eq '' && $ind>=$1) {
$ret=1; goto do ret;
} elsif($1 eq && $2 eq ) {
$ret=0; goto do ret;
} elsif($1<=$ind && $ind<=$2) {
$ret=1; goto do ret;
}
}

do ret:
return $ret;
}

sub VidaResolveMapInd {
my ($a vd,$map,$ind)=@_;
my ($key,$val,$ucount,$min,$mincount,$max,$maxcount,$all,$allcount,$part,$ret,$allval);
my $found=0;

$VidaLevel++;
VidaPrint("VidaResolveMapInd map=$map ind=$ind");

if($ind ne '') {
($ind,$ucount)=VidaEval($a vd,$ind);
if($ucount>0) {
goto do ret;
}
}

StrStripBoth($map);
StrStripBrackets($map,'[',']');
foreach $part (split(/;/,$map)) {
if($part =~ m/(.*)=>(.*)/) {
$key=$1; $val=$2;
StrStripBoth($key);
StrStripBoth($val);
if($key eq 'Minimum') {
($min,$mincount)=VidaEval($a vd,$val);
} elsif($key eq 'Maximum') {
($max,$maxcount)=VidaEval($a vd,$val);
} elsif($key eq 'Alle') {
$allval=$val; # defer
}
if($found<1) {
if(MapKeyEquInd($key,$ind)) {
$found++;
($ret,$ucount)=VidaEval($a vd,$val);
}
}
if($found<1) {
if($VidaAtomHash{$key}) {
$found++;
($ret,$ucount)=VidaEval($a vd,$val);
}
}
}
}
if($allval ne '' && $found<1) {
($all,$allcount)=VidaEval($a vd,$allval);
$ret=$all; $ucount=$allcount; $found++;
}
if($found<1) {
$ret="(Fehler: $map ($ind))"; $ucount++;
} elsif($ucount<1) {
if($min ne '' && $ret<$min) {
$ret=$min; $ucount=$mincount;
} elsif($max ne '' && $ret>$max) {
$ret=$max; $ucount=$maxcount;
}
}

do ret:
VidaPrint("VidaResolveMapInd ret=$ret ucount=$ucount map=$map ind=$ind");
$VidaLevel--;
return ($ret,$ucount);
}

sub BereichLimitMengeRetTeilLimit {
my ($bereich,$limit,$menge)=@_;
my $teil=0;
my ($lo,$hi)=MapKeyRetRange($bereich);

if($lo<$limit) {
$lo=$limit;
}
if($menge>$hi) {
$menge=$hi;
}
$teil=$menge-$lo;
if($teil<0) {
$teil=0;
}
$limit=$hi;
return ($teil,$limit);
}

sub VidaRetText SepEol {
my ($a vd,$sep,$eol)=@_;
my ($vline,$key,$val,$place,$valid);
my $ret;

foreach $vline (@$a vd) {
($key,undef,$val,$place,$valid)=split(/\|/,$vline);
$ret.="$key$sep$val$eol";
}
return $ret;
}

sub VidaVarRetValMarkUsed {
my ($a vd,$var,$mark)=@_;
my ($vline,$key,$val,$ret,$place,$valid);

foreach $vline (@$a vd) {
($key,undef,$val,$place,$valid)=split(/\|/,$vline);
if($VidaInvalid{$place}) {
next;
}
if($key eq $var) {
if($mark>0) {
$VidaUsed{$place}++;
}
$ret=$val;
goto do ret;
}
}
do ret:
return $ret;
}

sub VidaCacheVarsSepRetArrFilterPages {
my ($a vars,$sep,$a pages)=@_;
my (@ret,$var,$val,$count,$line,$pre,$id);

foreach $id (@$a pages) {
$line=$id;
$count=0;
foreach (@$a vars) {
$var=$_;
if($var =~ s/:$//) {
$pre="$var:";
} else {
$pre='';
}
$val=VidaCachePageVarRetVal($id,$var);
if($val ne '') {
$count++;
} else {
$pre='';
}
$line.=" $sep$pre$val";
}
if($count) {
push(@ret,$line);
}
}
return sort @ret;
}

sub VidaVarsSepRetArr {
my ($a vd,$a vars,$sep)=@_;
my (@ret,$vline,$key,$val,$ret,$place,$valid,%vhash);
my ($count,$page,%pages,%infos,$line,$ind,$info,$var,%vshow);

foreach $var (@$a vars) {
if($var =~ s/:$// ) {
$vshow{$var}++;
}
$vhash{$var}= ++$count;
}
foreach $vline (@$a vd) {
($key,undef,$val,$place,$valid)=split(/\|/,$vline);
$ind=$vhash{$key};
if($ind) {
$page=$place;
$page=~s/#.*$//;
$pages{$page}++;
$infos{$page}.="{$ind:$val}";
}
}
foreach $page (keys %pages) {
$line=$page;
$info=$infos{$page};
foreach $var (@$a vars) {
$ind=$vhash{$var};
$line.=" $sep";
$val=KnowStrVarRetVal($info,$ind);
if($val ne '') {
if($vshow{$var}) {
$line.="$var:";
}
$line.=$val;
}
}
push(@ret,$line);
}
return sort @ret;
}

sub VidaVarRetVal {
my ($a vd,$var,$mark)=@_;
return VidaVarRetValMarkUsed($a vd,$var,$mark);
}

sub VidaVarListRetVal {
my $a vd=shift;
my $ret;
foreach (@_) {
if($_ =~ m/^=/) { # for defaults
$ret=$';
} else {
$ret=VidaVarRetVal($a vd,$_);
}
if($ret ne '') {
goto do ret;
}
}
do ret:
return $ret;
}

sub VidaTabValRetSteuer {
my ($a vd,$tabname,$menge)=@_;
my $steuer=0;
my $limit=0;
my ($bereich,$satz,$ucount,$map,$part,$teil);

$map=VidaVarRetValMarkUsed($a vd,$tabname,1);
# MsgPrint("VidaTabValretSteuer tab=$tabname menge=$menge map=$map");
StrStripBoth($map);
StrStripBrackets($map,'[',']');
foreach $part (split(/;/,$map)) {
if($part =~ m/(.*)=>(.*)/) {
$bereich=$1;
($satz,$ucount)=VidaEval($a vd,$2);
# MsgPrint(" part=$part bereich=$bereich val=$2 satz=$satz");
($teil,$limit)=BereichLimitMengeRetTeilLimit($bereich,$limit,$menge);
$steuer += $satz * $teil;
}
}
return ($steuer,$ucount);
}

sub VidaResolveAtom {
my ($a vd,$atom)=@_;
my ($vd,$var,$val,$ucount,$ind,$icount);
my ($recur,$map,$key,$place,$valid,$tabname);
my $ret=$atom;

$VidaLevel++;
VidaPrint("VidaResolveAtom atom=$atom");

if($VidaRecur++>100) {
return "(Rekursionsfehler: $atom)";
}
foreach $vd (@$a vd) {
($var,undef,$val,$place,$valid)=split(/\|/,$vd);
if($VidaInvalid{$place}) {
next;
}
if($var eq $atom) {
$VidaUsed{$place}++;
($ret,$ucount)=VidaEval($a vd,$val);
goto do ret;
}
}
if($atom =~ m/^([$AnyLetterList]+)$([$AnyLetterList\($]+)\)$/ ) { #hash
$map=$1; $key=$2;
if($map eq 'Steuerberechnung') {
if($key =~ m/^([$AnyLetterList]+)$([$AnyLetterList\($]+)\)$/ ) { #hash
$tabname=$1; $var=$2;
($ret,$ucount)=VidaEval($a vd,$var);
if($ucount<1) {
($ret,$ucount)=VidaTabValRetSteuer($a vd,$tabname,$ret);
}
}
goto do ret;
}
foreach $vd (@$a vd) {
($var,undef,$val,$place,$valid)=split(/\|/,$vd);
if($VidaInvalid{$place}) {
next;
}
if($var eq $map) {
$VidaUsed{$place}++;
($ret,$ucount)=VidaResolveMapInd($a vd,$val,$key);
goto do ret;
}
}
}
if($atom =~ m/^($|$)$/) {
# ok
} else {
push(@VidaError,"Auflösung von $atom nicht möglich");
}

do ret:
VidaPrint("VidaResolveAtom ret=$ret err=$ucount atom=$atom");
$VidaLevel--;
return ($ret,$ucount);
}

sub VidaResolveList {
my ($a vd,$list)=@_;
my @parts=split(/\s+/,$list);
my ($ret,$ucount,$u,$part,$serr);

$VidaLevel++;
VidaPrint("VidaResolveList list=$list");

if($VidaRecur++>100) {
$ret="(Rekursionsfehler: $list)"; $ucount=1;
goto do ret;
}
foreach (@parts) {
if($_ =~ m/^[\d\.]+$/) {
# nop
} elsif($_ =~ m/^([$AnyLetterList]+)$/) {
($_,$u)=VidaResolveAtom($a vd,$1);
$ucount+=$u;
if($u>0) {
$serr="$_ ";
}
}
}
$ret=join(" ",@parts);

VidaPrint("VidaResolveList ret=$ret err=$ucount list=$list");
$VidaLevel--;
if($ucount>0) {
$ret=$serr;
}
return ($ret,$ucount);
}

sub VidaEval {
my ($a vd,$term)=@_;
my ($ret,$formula,$ucount,$stat);

if($term =~ m/^[\d\.]+$/) {
$ret=$term;
goto do shortcut;
}

$VidaLevel++;
VidaPrint("VidaEval term=$term");

if($term =~ m/^\[/) {
($formula,$ucount)=VidaResolveMapInd($a vd,$term,'');
} elsif($term =~ m/ /) {
($formula,$ucount)=VidaResolveList($a vd,$term);
} else {
($formula,$ucount)=VidaResolveAtom($a vd,$term);
}
if($ucount<1) {
$stat= eval('$ret= (' . $formula . ');');
if($stat eq '') {
$ret=$formula;
if( ! ($ret=~m/#Fehler/) ) {
$ret="#Fehler: $ret";
$ucount=1;
}
}
} else {
$ret=$formula;
}

VidaPrint("VidaEval ret=$ret err=$ucount term=$term");
$VidaLevel--;
do shortcut:
return ($ret,$ucount);
}

sub VidaAtomValid {
my ($at)=@_;
if($at =~ m#[\s\[\]\{\}]# ) {
return 0;
}
if($at =~ m#^[\d_.,]*$# ) {
return 0;
}
return 1;
}

sub VidaAtomHashBuild {
my ($a vd)=@_;
my ($vd,$var,$val,$place,$valid,$count);

%VidaAtomHash=();
foreach $vd (@$a vd) {
($var,undef,$val,$place,$valid)=split(/\|/,$vd);
if($VidaInvalid{$place}) {
next;
}
if(VidaAtomValid($var)) {
$VidaAtomHash{$var}++;
if($VidaAtomHash{$var}<=1) {
if(VidaAtomValid($val)) {
$VidaAtomHash{$val}++;
}
}
}
}
}

sub VidaEvalMaster {
my ($a vd,$term)=@_;
my ($ret,$ucount);

StrStripBoth($term);

$VidaRecur=0;
$VidaLevel=0;

VidaPrint("VidaEvalMaster term=$term");
($ret,$ucount)=VidaEval($a vd,$term);
VidaPrint("VidaEvalMaster ret=$ret term=$term");
return $ret;
}

sub VidaInit {
%VidaUsed=();
}

sub ListRetArray {
my ($list)=@_;
my @ar=split(/[\s;,]+/,$list);
return @ar;
}

sub ValidEquVal { # also regex
my ($valid,$val)=@_;
my $ret=0;
if($valid =~ m#$$val$# ) {
$ret=1;
}
return $ret;
}

sub ValidEquArray {
my ($valid,$a ar)=@_;
foreach (@$a ar) {
if(ValidEquVal($valid,$_)) {
return 1;
}
}
return 0;
}

sub VidaInvalidBuild {
my ($a vd)=@_;
my $vcl=VidaVarRetVal($a vd,'ValidCheckList');
my @vcar=ListRetArray($vcl);
my ($vc,$vline,%rehash,%elhash,%sollhash,$re,$el,@el,$valid,$place,$soll,$var,$val);

%VidaInvalid=();

if(int(@vcar)==0) {
return;
}
foreach $vc (@vcar) {
$soll=VidaVarRetVal($a vd,$vc);
if($soll eq '') {
next; # FIXME: opt could be deleted from @vcar
}
$sollhash{$vc}=$soll;
$el=VidaVarRetVal($a vd,"ValidEnumList($vc)");
if($el ne '') {
@el=ListRetArray($el);
@{$elhash{$vc}}=@el;
next;
}
$re=VidaVarRetVal($a vd,"ValidRegex($vc)");
if($re ne '') {
$rehash{$vc}=$re;
next;
}
$elhash{$vc}=($vc);
}
LINE:
foreach $vline (@$a vd) {
($var,undef,$val,$place,$valid)=split(/\|/,$vline);
if($valid eq '') {
next;
}
foreach $vc (@vcar) {
$soll=$sollhash{$vc};
if($soll eq '') {
next;
}
if(ValidEquVal($valid,$soll)) {
next;
}
@el=@{$elhash{$vc}};
if($el[0] ne '') {
if(ValidEquArray($valid,\@el)) {
$VidaInvalid{$place}++;
}
next;
}
$re=$rehash{$vc};
if($re ne '') {
if(ValidEquVal($valid,$re)) {
$VidaInvalid{$place}++;
}
}
}
}
}

sub NumberFmtRetStr {
my ($n,$fmt)=@_;
my $ret=$n;
my $dez=0;
my ($n2,$p1,$p2,$p3,$pt,$sep,$re);

if($fmt=~ m/[\d_.,]+/) {
$p1 = $`; $p2 = $&; $p3 = $';
$p2 =~ s/([.,])(\d*)([^\d.,])*$/{$pt=$1;$dez=length($2);$3;}/e;
$p2 =~ m/[_.,]/;
$sep=$&;
$n2=sprintf("%.*f",$dez,$n);
if($pt ne '.') {
$n2 =~ s/\./$pt/;
}
if($sep ne '') {
if($dez==0) {
$n2 =~ s/(\d)(\d\d\d)$/$1$sep$2/;
}
$n2 =~ s/(\d)(\d\d\d)([_.,])/$1$sep$2$3/;
$n2 =~ s/(\d)(\d\d\d)([_.,])/$1$sep$2$3/;
$n2 =~ s/(\d)(\d\d\d)([_.,])/$1$sep$2$3/;
}
$ret=$p1.$n2.$p3;
}
return $ret;
}

]

AndriusKulikauskas March 3, 2009 17:48 CET I'm not able to paste something in the rest.

sub DownSize {
  my ($p_val)=@_;
  my $ret=$$p_val;
  $ret /= 16;
  $ret += 0.5;
  $ret =~ s/\..*$//;
  $$p_val=$ret;
}

AndriusKulikauskas March 3, 2009 17:48 CET I'm not able to paste something in the rest.

General

Documentation

Help & Communication

Navigation & Search

Local administration