#!/usr/bin/perl use strict; use vars qw(%form $VERSION $DATA_DIR $IMG_DIR $HTML_DIR $LANGUE); use vars qw(%blocs); my $flagTXT3=0; my %blocksave3; my $flagTXT4=0; my %blocksave4; $VERSION='0.1'; $DATA_DIR='data'; $IMG_DIR='http://www.impens.com/img/'; $HTML_DIR='../html/'; #decoder les parametres %form=&receive_getpost; $LANGUE=$form{'L'}; if ($LANGUE eq'') {$LANGUE='FR'}; print "Content-type: text/html\n\n"; print ' La peinture murale du XIIéme au XVIIéme siècle en France et ailleurs / Murals of the XIIth to XVIIth century in France and elsewhere '; &editdeb($IMG_DIR,$LANGUE); my $l1="";my $l2="";my $l3=""; &loadblocs($LANGUE,$form{'P1'}); &editfin($IMG_DIR,$LANGUE,$l1,$l2,$l3); print ""; #----------------------------------------------------------------------------- sub trim { my $string = shift; for ($string) { s/^\s+//; s/\s+$//; } return $string; } #----------------------------------------------------------------------------- sub loadblocs { my ($LG,$num)=@_; open(TXT,'< data/blocs.txt'); while (not eof(TXT)) { my ($key,$ptrup,$FR,$UK,$IMG,$Justif)=split('\t',); if( $num eq $ptrup ) { my $TXT=""; $TXT=$FR if($LG eq "FR"); $TXT=$UK if($LG eq "UK"); $TXT=~ s/\"//g; chomp($TXT); chomp($Justif); $Justif=&trim($Justif); chomp($IMG); $IMG=&trim($IMG); if( substr($IMG,0,4) eq "PTR=" ) { my $ptr=substr($IMG,4); $TXT="".$TXT.""; $l1=$TXT if( $Justif eq "LEFT"); $l2=$TXT if( $Justif eq "CENTER"); $l3=$TXT if( $Justif eq "RIGHT"); } else { &editbloc($Justif,$IMG,$TXT,$LG); } } } close(TXT); } #----------------------------------------------------------------------------- sub editbloc { my ($STYLE,$FICHIER,$TEXTE,$LG)=@_; my $langue=0; $langue=1 if($LG eq "FR"); $langue=2 if($LG eq "UK"); if ( $STYLE eq 'LEFT' ) { print ""; print ""; print ""; print "

".$TEXTE."

"; }; if ( $STYLE eq 'RIGHT' ) { print ""; print ""; print ""; print "

".$TEXTE."

"; }; if ( $STYLE eq 'CENTER' ) { print ""; print ""; print "

".$TEXTE."

"; }; if ( $STYLE eq 'MAP' ) { print ""; print ""; print "
".$TEXTE."
"; }; if ( $STYLE eq '' ) { print ""; print ""; print "

".$TEXTE."

"; }; my $hx ="H1"; if ( $STYLE eq 'HEAD1' ) { $hx="H1"; $STYLE="HEADX"; }; if ( $STYLE eq 'HEAD2' ) { $hx="H2"; $STYLE="HEADX"; }; if ( $STYLE eq 'HEAD3' ) { $hx="H3"; $STYLE="HEADX"; }; if ( $STYLE eq 'HEAD4' ) { $hx="H4"; $STYLE="HEADX"; }; if ( $STYLE eq 'HEADX' ) { print ""; print ""; print "
<".$hx.">".$TEXTE."
"; }; if ( $STYLE eq 'UPDATE' ) { printf "

%s

",$TEXTE; my %tbl=&loadUPD("tblnew",0); my $ccR=0xd0; my $ccG=0xd0; my $ccB=0x81; map { printf "" ,$ccR,$ccG,$ccB,$tbl{$_}[4],$tbl{$_}[3] ,$ccR,$ccG,$ccB,$tbl{$_}[2] ,$ccR,$ccG,$ccB,$tbl{$_}[1]; $ccR=$ccR-1 if($ccR>5); $ccG=$ccG-0 if($ccG>5); $ccB=$ccB-1 if($ccB>5); } sort keys %tbl; printf "
%s %s %s

" }; my $sup1=int($form{"P1"}/10); if ( $sup1==11) { $form{"P2"}="ALL" }; redoit: my $level=0; my $htxt=""; if ( $STYLE eq 'SEARCH1' ) { $level=1; $STYLE="SEARCHX"; }; if ( $STYLE eq 'SEARCH2' ) { $level=2; $STYLE="SEARCHX"; }; if ( $STYLE eq 'SEARCH3' ) { $level=3; $STYLE="SEARCHX"; }; if ( $STYLE eq 'SEARCH4' ) { $level=4; $STYLE="SEARCHX"; }; if ( $STYLE eq 'SEARCH5' ) { $level=5; $STYLE="SEARCHX"; }; if ( $STYLE eq 'SEARCHX' ) { my %tbl=&loadTBL("tblcountry",0); my $par2=""; my ($C1,$C2,$C3,$C4)=split(",",$form{"X"}); $htxt=$htxt."

".$TEXTE."

"; if (( $level==2 ) && ( $C1==1 )){ $htxt=$htxt."";}; if (( $level==2 ) && ( $C1==2 )){ $htxt=$htxt."";}; $htxt=$htxt."
"; $htxt=$htxt."
"; }; if ( $STYLE eq 'LIST' ) { my ($C1,$C2,$C3)=split(",",$form{"X"}); my %tbl1=&loadTBL("tblcountry",0); my %tbl2=&loadTBL("tblregion",$C1); my %tbl3=&loadTBL("tbldep",$C2); print "

"; print "  " .$tbl1{$C1}[$langue].""; print " > " .$tbl2{$C2}[$langue].""; print " > " .$tbl3{$C3}[$langue].""; print "

"; print "".$TEXTE.""; my %tbl4=&loadTBL("tbllieu",$C3); my $C4max=0; map { if($C4max<$_){$C4max=$_} } sort keys %tbl4; map { my $C4=$_; #my %tbl5=&loadTBL3("tblbati",$C4,$C4max); my %tbl5=&loadTBL("tblbati",$C4); my $C5max=0; map { if($C5max<$_){$C5max=$_} } sort keys %blocksave3; map { my $C5=$_; my $nomdulieu=$tbl4{$C4}[1]; $nomdulieu=~ s/\-,/ /g; my $ageo=""; #print ""; print ""; print ""; #my %tbl=&loadTBL4("tbldesc",$C5,$C5max); my %tbl=&loadTBL("tbldesc",$C5); my $mapyes=0; map { $mapyes=1 if(index($tbl{$_}[$langue],"maps.google.be")>0); } sort keys %tbl; if($mapyes==1){ if($LG eq "FR") { print "" ; } else { print "" ; }; } else { map { print "" if ( (&trim($tbl{$_}[3]) ne "maps")&&(index($tbl{$_}[$langue],"maps.google.be")<0) ); } sort keys %tbl; }; } sort keys %tbl5; } sort keys %tbl4; print "
".$ageo.$tbl4{$C4}[$langue]."
" .$tbl4{$C4}[$langue]." " .$tbl5{$C5}[$langue]."
Pour une description complète et illustrée de ce lieu, cliquez ici.
Click here to see a complete and illustrated description for this place.
".$tbl{$_}[$langue]."
"; }; if ( $STYLE eq 'SEARCH6' ) { my ($C1,$C2,$C3,$C4,$C5)=split(",",$form{"X"}); my %tbl1=&loadTBL("tblcountry",0); my %tbl2=&loadTBL("tblregion",$C1); my %tbl3=&loadTBL("tbldep",$C2); my %tbl4=&loadTBL("tbllieu",$C3); my %tbl5=&loadTBL("tblbati",$C4); my %tbl=&loadTBL2("tbldesc",$C5); print "

"; print "  " .$tbl1{$C1}[$langue].""; print " > " .$tbl2{$C2}[$langue].""; print " > " .$tbl3{$C3}[$langue].""; print " > " .$tbl4{$C4}[$langue].""; print " > ".$tbl5{$C5}[$langue].""; print "
"; my $n=0; map { my $FICHIER = &trim($tbl{$_}[3]); if ( $FICHIER ne "" ) { my @ff=split ",", $FICHIER; if($#ff<1){ $FICHIER = $FICHIER.".jpg"; if ( ( $n % 2 ) eq 1 ) { print ""; print ""; print ""; print "

".$tbl{$_}[$langue]."

"; } else { print ""; print ""; print ""; print "

".$tbl{$_}[$langue]."

"; } } else { print ""; print ""; print ""; print "
"; } } else { print ""; print ""; print "

".$tbl{$_}[$langue]."

"; }; $n++; } sort keys %tbl; print "
" }; } #----------------------------------------------------------------------------- #----------------------------------------------------------------------------- sub editonebox { my ($DIMG,$LG,$VPOS,$THPOS,$TVPOS,$HREF,$TEXFR,$TEXUK)=@_; my $TEX=$TEXFR if($LG eq "FR"); $TEX=$TEXUK if($LG eq "UK"); print "

"; print "
"; print "
".$TEX."
"; print "
".$TEX."
"; print "
"; } sub editonebox2 { my ($DIMG,$LG,$VPOS,$THPOS,$TVPOS,$HREF,$TEXFR,$TEXUK)=@_; my $TEX=$TEXFR if($LG eq "FR"); $TEX=$TEXUK if($LG eq "UK"); print "
"; print "
"; #print "
".$TEX."
"; print "
".$TEX."
"; print "
"; } sub editonebox4 { my ($DIMG,$LG,$VPOS,$THPOS,$TVPOS,$HREF,$TEXFR,$TEXUK)=@_; my $TEX=$TEXFR if($LG eq "FR"); $TEX=$TEXUK if($LG eq "UK"); print "
"; print "
"; #print "
".$TEX."
"; print "
".$TEX."
"; print "
"; } sub editonebox3 { my ($DIMG,$LG,$VPOS,$THPOS,$TVPOS,$HREF,$TEXFR,$TEXUK)=@_; my $TEX=$TEXFR if($LG eq "FR"); $TEX=$TEXUK if($LG eq "UK"); print "
"; print "
".$TEX."
"; print "
".$TEX."
"; print "
"; } #----------------------------------------------------------------------------- sub editdeb { my ($DIMG,$LG)=@_; print ""; print "
"; print "
"; print "
"; &editonebox2($DIMG,$LG, 1,5,1,"'page.cgi?P1=0&L=".$LG."'","Page d'entrée","Home"); &editonebox2($DIMG,$LG, 6,5,1,"'page.cgi?P1=1&L=".$LG."'","Introduction","Introduction"); &editonebox2($DIMG,$LG,11,5,1,"'page.cgi?P1=301&L=".$LG."'","Dernières modif.","Last updates"); &editonebox3($DIMG,$LG,16,5,1,"","Découverte","The visit"); &editonebox2($DIMG,$LG,21,5,1,"'page.cgi?P1=201&L=".$LG."'","Eglise de Brinay","Church of Brinay"); &editonebox2($DIMG,$LG,26,5,1,"'page.cgi?P1=251&L=".$LG."'","Eglise de Jenzat","Church of Jenzat"); &editonebox2($DIMG,$LG,31,5,1,"'page.cgi?P1=101&L=".$LG."'","Autres églises","Other churches"); &editonebox2($DIMG,$LG,36,5,1,"'page.cgi?P1=111&L=".$LG."'","Inventaire
complet","Complete
list"); &editonebox3($DIMG,$LG,41,5,1,"","Références","References"); &editonebox4($DIMG,$LG,46,5,1,"'page.cgi?P1=10&L=".$LG."'","Technique","Techniques"); &editonebox4($DIMG,$LG,51,5,1,"'page.cgi?P1=80&L=".$LG."'","Biblio.","Bibliography"); &editonebox4($DIMG,$LG,56,5,1,"'page.cgi?P1=90&L=".$LG."'","Autres liens","Other links"); &editonebox4($DIMG,$LG,66,5,1,"'page.cgi?P1=405&L=".$LG."'","Crédits","Thanks"); &editonebox4($DIMG,$LG,71,5,1,"'page.cgi?P1=401&L=".$LG."'","contact","Contact"); print "
"; } #----------------------------------------------------------------------------- sub editfin { my $k; my ($DIMG,$LG,$link1,$link2,$link3)=@_; print "
"; #menu de droite vide print "
"; print "
"; print "

".$link1."

"; print "
"; print "
"; print "

".$link2."

"; print "
"; print "
"; print "

".$link3."

"; print "
"; print "
"; print "
"; print ""; print ""; print ""; print ""; print "
"; print "
"; print ""; for ($k=5;$k>=0;$k--) {print "";}; print "
"; print "
(c)Yves Impens, 2007-2012"; print ""; print "Webstat4U"; print "
"; print "
"; } #--------------------------------------------------------------------------------------------- #decodage des parametres d'appel sub receive_getpost { my (%postdata,$data,$pair); $data=''; if ($ENV{'REQUEST_METHOD'} eq 'POST') { my $len=$ENV{'CONTENT_LENGTH'}; if (read(STDIN,$data,$len) != $len) {print ("

error reading post data

"); die("Error reading 'POST' data\n"); } } elsif ($ENV{'REQUEST_METHOD'} eq 'GET') { $data=$ENV{'QUERY_STRING'}; } foreach $pair (split('&',$data)) { my ($name,$value)=split('=',$pair); $name=~ tr/\0//d; $value=~ tr/\0//d; $name =~ tr/+/ /; $name =~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge; $value=~ tr/+/ /; $value=~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge; $postdata{$name}=$value; } return %postdata; } #-------------------- sub loadUPD { my %blocs; open(TXT,"< data/".$_[0].".txt"); while (not eof(TXT)) { my ($key,$ptr,$DD,$TX,$XX)=split('\t',); my ($TX1,$TX2) = split "/", $TX; my $key2=(2025-substr($DD,6,4)).(100-substr($DD,3,2)).(100-substr($DD,0,2)).$key; $blocs{$key2}=[$ptr,$DD,$TX1,$TX2,$XX]; } close(TXT); return %blocs; } sub loadTBL { my %blocs; open(TXT,"< data/".$_[0].".txt"); while (not eof(TXT)) { my ($key,$ptr,$FR,$UK,$II,$III)=split('\t',); $FR=~ s/\;/\/g; $UK=~ s/\;/\/g; $FR=~ s/\"//g; $UK=~ s/\"//g; $UK=$FR if($UK eq ""); #garder seulement les entrees concernees et avec illustration $blocs{$key}=[$ptr,$FR,$UK,$II,$III] if($key!="")&&($ptr==$_[1])&&(($III>0)||( $form{"P2"} eq "ALL" )); } close(TXT); return %blocs; } sub loadTBL2 { my %blocs; open(TXT,"< data/".$_[0].".txt"); while (not eof(TXT)) { my ($key,$ptr,$FR,$UK,$II,$III)=split('\t',); if(substr($FR,0,3) ne "/g; $FR=~ s/\"//g; }; if(substr($UK,0,3) ne "/g; $UK=~ s/\"//g; }; $UK=$FR if($UK eq ""); #garder seulement les entrees concernees $blocs{$key}=[$ptr,$FR,$UK,$II,$III] if($key!="")&&($ptr =~ $_[1]); } close(TXT); return %blocs; } sub loadTBL3 { my ($file,$idf,$idfmax)=@_; #printf "%s %d %d
",$file,$idf,$idfmax; my %blocs; if($flagTXT3==0){ open(TXT3,"< data/".$file.".txt"); $flagTXT3=1; while (not eof(TXT3)) { my ($key,$ptr,$FR,$UK,$II,$III)=split('\t',); $FR=~ s/\;/\/g; $UK=~ s/\;/\/g; $FR=~ s/\"//g; $UK=~ s/\"//g; $UK=$FR if($UK eq ""); #garder seulement les entrees concernees $blocs{$key}=[$ptr,$FR,$UK,$II,$III] if($key!="")&&($ptr =~ $idf); $blocksave3{$key}=[$ptr,$FR,$UK,$II,$III] if($key!="")&&($ptr >= $idf)&&($ptr <= $idfmax); } close(TXT3); } else { map { $blocs{$_}=$blocksave3{$_} if($blocksave3{$_}[0]==$idf); } sort keys %blocksave3; }; return %blocs; } sub loadTBL4 { my ($file,$idf,$idfmax)=@_; #printf "%s %d %d
",$file,$idf,$idfmax; my %blocs; if($flagTXT4==0){ open(TXT,"< data/".$file.".txt"); $flagTXT4=1; while (not eof(TXT)) { my ($key,$ptr,$FR,$UK,$II,$III)=split('\t',); $FR=~ s/\;/\/g; $UK=~ s/\;/\/g; $FR=~ s/\"//g; $UK=~ s/\"//g; $UK=$FR if($UK eq ""); #garder seulement les entrees concernees $blocs{$key}=[$ptr,$FR,$UK,$II,$III] if($key!="")&&($ptr =~ $idf); $blocksave4{$key}=[$ptr,$FR,$UK,$II,$III] if($key!="")&&($ptr >= $idf)&&($ptr <= $idfmax); } close(TXT); } else { map { $blocs{$_}=$blocksave4{$_} if($blocksave4{$_}[0]==$idf); } sort keys %blocksave4; }; return %blocs; }