#!/usr/bin/perl
# Please change the previous ligne with you perl location
######################################################################
#
# ManyPage : Moteur de Publication de site Web
# ManyPage : Web site Management tools
#
#
# Auteur/Author : Pierre Cordani
# Collaborateur/Contributor : Pascal Vuylsteker, MediaPort team
#
# Documentation : http://www.vrarchitect.net/ManyPage
# Question : manypage@vuylsteker.net
#
# Creation : 1/1/00
# Modification : 1/12/00
# Version : 0.9
# SoftVersion : Perl 5
######################################################################
#
# main.pl : principal file
#
#
######################################################################
#
# Copyright (C) 2000 Pierre Cordani - Pascal Vuylsteker
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# Ce programme est un logiciel libre ; vous pouvez le redistribuer et/ou le modifier conformŽment
# aux dispositions de la Licence Publique GŽnŽrale GNU, telle que publiŽe par la Free Software
# Foundation ; version 2 de la licence, ou encore (ˆ votre choix) toute version ultŽrieure.
#
###################
# Preffixe des mes tags
$Home_Path = $0;
$Home_Path =~ s/(.*)\/.*/$1/;
push(@INC, $Home_Path);
require "flush.pl";
require 'lecture.pl'; # Lecture des fichiers objets
require 'transfert.pl'; # Creations de clones
require 'creation_lien.pl'; # Creation des fichiers jumeaux
require 'parallele.pl'; # Gestion des liens pour un habillage parallele
require 'ecriture.pl'; # Ecriture de clones
require 'recursivite.pl'; # Fonction de recursivite
require 'title.pl'; # recherche des titres des fichiers back, next et up
require 'utils.pl'; # Differents utilitaires
require 'image_size.pl'; # taille des images
require 'transfert_autre.pl'; # Transfert des images, ...
require 'ecriture_obj.pl'; # ecriture des objets
$Version = 'ManyPage 0.9';
$Auteur = 'Pierre Cordani';
$Contributor = 'Pascal Vuylsteker'; # ;-) de PVK
#Ce tag est propre au programme, il sert de tag buffer
$Mon_Pref = 'SAPI';
# Liste des TAGS devant etre geres pour relativiser les liens
@TAGS = ('HREF','SRC','BACKGROUND','CODE');
# Liste des TAGS du format SGML a traiter,
# On peut en rajouter, mais pas en modifier,
# Sinon, plus rien ne marchera
$Doc_Type = "\n";
$Tag_Langages = 'PM.LANGAGE';
$Meta_Info = "\n";
@Tags_traiter = ('MP.MENU.LINK.NEXT.','MP.MENU.LINK.BACK.','MP.MENU.LINK.UP.',
'MP.MENU.LANG.','MP.WARNING.LANG.',
'MP.SIGNATURE.','MP.COMMENTS.',
'MP.COPYRIGHT.','MP.MENU.HELP.',
'MP.MENU.HOME.');
@Tags_traduir = ('.NEXT.','.BACK.','.UP.',
'.LANG.','.WARNING.',
'.SIGNATURE.','.COMMENTS.',
'.COPYRIGHT.','.HELP.',
'.HOME.');
@wkday = ("Mon","Tue","Wed","Thu","Fri","Sat","Sun");
@weekday = ("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday");
@month = ("Jan","Feb","Mar","Apr",
"May","Jun","Jul","Aug",
"Sep","Oct","Nov","Dec");
# Nombre maximal de remplacement dans un objet, pour eviter une boucle
# Infinie.
#
# Il faudrait trouver une methode de detection de cycle
$Nb_rec_max = 300;
#Nom des fichiers servant a l'habillage
$Habillage_file = ".obj";
$Original = ".dress";
$Liens = ".link";
$Obj_brut_dest = ".obj.final.brut";
$Obj_net_dest = ".obj.final.net";
($Source, $Dest) = &lecture_config();
$First_Source = $Source;
$SAPI_LT = "SAPI_LT";
$SAPI_GT = "SAPI_GT";
$Filtre_fichier = "";
$File_Cont = 0;
&main;
###################
#
# Fonction que je ne commenterai pas pour
# Ainsi avoir une assurance travail
#
# Bon d'accord, cette fonction recoit un pointeur sur hash table d'hash table
# ex: T{"cle1"}{"cle2"} = valeur
# Et j'en fais simplement une copie pour pouvoir utiliser la
# Recursivite dans mon programme, autrement, ca ne marche pas
#
# Il n'y a aucun moyen a ma connaissance pour pouvoir passer
# Une copie de cet objet en parametre a une fonction
# Donc, je fais une copie a la main
#
# %{} sert a referencer une hash table
# L'objet s est un tableau contenant des couples (cle,hash)
# $s[i] est la cle
# $s[i+1] est un pointeur sur hash
#
# Remarque : Plus de commentaire que de code, ce n'est point normal
#
###################
sub copy_hash_of_hash
{local (*s) = @_;
local (%T);
local ($i) = 0;
while($s[$i])
{
%{$T{$s[$i]}} = %{$s[$i+1]};
$i+=2;
}
return {%T};
}
###################
#
# Debut de la section Lecture des Liens
#
# On gere le fichier $Liens pour la gestion de la navigation
#
###################
sub fin_arb
{local ($my_n,$my_end,*Mes_Liens_a) = @_;
local (%Mes_Liens_b) = %Mes_Liens_a;
for(local $j = $my_n; $j > $my_end; $j--)
{
# print "** $i : $Liens_info[1][$j] <-> $Liens_info[2][$j]";
if($Liens_info[2][$j-1])
{$up = $Liens_info[2][$j-1];
# print" ($Liens_info[2][$j-1])\n"
}
else
{$up = $Liens_info[1][$j-1];
# print" ($Liens_info[1][$j-1])\n"
}
if($Liens_info[2][$j])
{
$Mes_Liens_b{$Liens_info[2][$j]}{"Back"} = $Liens_info[1][$j];
$Mes_Liens_b{$Liens_info[2][$j]}{"Next"} = '';
$Mes_Liens_b{$Liens_info[2][$j]}{"Up"} = $up;
}
else
{
$Mes_Liens_b{$Liens_info[1][$j]}{"Back"} = '';
$Mes_Liens_b{$Liens_info[1][$j]}{"Next"} = '';
$Mes_Liens_b{$Liens_info[1][$j]}{"Up"} = $up;
}
$Liens_info[0][$j] = '';
$Liens_info[1][$j] = '';
$Liens_info[2][$j] = '';
$i = 1;
}
return {%Mes_Liens_b};
}
###################
#
# Fonction gerant la lecture des liens de fichiers sgml et html
#
###################
sub make_liens
{local ($name) = @_;
open (LIENS,$name."/".$Liens) or die "Probleme avec $name/$Liens\n";
local (%Mes_Liens) = ();
undef @Liens_info;
local (%Les_Liens_Of_Info) = ();
$i = 1;
$nb_max = 0;
$nb_prec = 1;
#
# Pour chaque fichier, on memorisera son back, son next et son up.
# A chaque fois que j'ai suffisament de connaissances concernant
# L'un des fichiers, je memorise le tout dans le hash de hash
# %Mes_Liens.
#
# Dans le hash %Les_Liens_Of_Info, je memorise les fichiers
# Images que je devrai creer (...)
#
while($info = )
{
next if($info =~ /( |\t)*($Liens_info[$i][$n])\n";
if($Liens_info[$i][$n] eq ''){$i = 1}
else
{$i = 2;
if($Liens_info[2][$n])
{
$Liens_info[0][$n] = $Liens_info[1][$n];
$Liens_info[1][$n] = $Liens_info[2][$n];
$Liens_info[2][$n] = '';
}
}
$Liens_info[$i][$n] = $info;
$Les_Liens_Of_Info{$info} = $Les_liens_of;
if($Liens_info[2][$n]) #Nous avons suffissament de fichiers pour creer des liens entre eux
{
# print "$i : $Liens_info[0][$n] <-> $Liens_info[1][$n] <-> $Liens_info[2][$n]";
# Back <-> Self <-> Next
# Ici nous avons l'information sur le pere (ou la mere si tu preferes)
if($Liens_info[2][$n-1])
{$up = $Liens_info[2][$n-1];
# print" ($Liens_info[2][$n-1])\n"
}
else
{$up = $Liens_info[1][$n-1];
# print" ($Liens_info[1][$n-1])\n"
}
$Mes_Liens{$Liens_info[1][$n]}{"Back"} = $Liens_info[0][$n];
$Mes_Liens{$Liens_info[1][$n]}{"Next"} = $Liens_info[2][$n];
$Mes_Liens{$Liens_info[1][$n]}{"Up"} = $up;
}
# print "$n : $_";
}
*Mes_Liens = &fin_arb($n,0,copy_hash_of_hash[%Mes_Liens]);
close (LIENS);
# L'arborescence est finie
# &debug_lien({%Mes_Liens});
return ({%Mes_Liens},{%Les_Liens_Of_Info});
}
###################
#
# Fin de la section Lecture des Liens
#
###################
###################
#
# Cette fonction gere les tests
# Simple mais efficace
#
###################
sub gestion_test
{local ($text) = @_;
local ($buffer) = $text;
while($buffer =~ /(<\s*PM\.IF\s*(EXIST|NOEXIST|TEST)\s*=\s*\`\s*(.*?)\s*\`\s*THEN\s*=\s*\`(.*?)\`\s*(?:ELSE\s*=\s*\`(.*?)\`\s*)?\s*>)/is)
{
$Le_tout = $1;
$Le_test = $2;
$Le_if = $3;
$Le_then = $4;
$Le_else = $5;
if(!$Le_else){$Le_else = ""}
if($Le_if =~ /.*PM\.IF.*/is || $Le_then =~ /.*PM\.IF.*/is || $Le_else =~ /.*PM\.IF.*/is)
{
$buffer =~ s/\Q$Le_tout\E//gs;
}
else
{
if($Le_test =~ /^TEST$/i)
{
if($Le_if =~ /^\s*(.*?)\s*PM\.(..)\s*(.*?)\s*$/is)
{
local($first,$the_test,$second) = ($1,uc($2),$3);
if($the_test eq "EQ")
{
if($first eq $second)
{
$buffer =~ s/\Q$Le_tout\E/$Le_then/s;
}
else
{
$buffer =~ s/\Q$Le_tout\E/$Le_else/s;
}
}
elsif($the_test eq "NE")
{
if($first ne $second)
{
$buffer =~ s/\Q$Le_tout\E/$Le_then/s;
}
else
{
$buffer =~ s/\Q$Le_tout\E/$Le_else/s;
}
}
elsif($the_test eq "LT")
{
if($first lt $second)
{
$buffer =~ s/\Q$Le_tout\E/$Le_then/s;
}
else
{
$buffer =~ s/\Q$Le_tout\E/$Le_else/s;
}
}
elsif($the_test eq "GT")
{
if($first gt $second)
{
$buffer =~ s/\Q$Le_tout\E/$Le_then/s;
}
else
{
$buffer =~ s/\Q$Le_tout\E/$Le_else/s;
}
}
elsif($the_test eq "CT")
{
if($first =~ /.*$second.*/)
{
$buffer =~ s/\Q$Le_tout\E/$Le_then/s;
}
else
{
$buffer =~ s/\Q$Le_tout\E/$Le_else/s;
}
}
elsif($the_test eq "NC")
{
if(!($first =~ /.*$second.*/))
{
$buffer =~ s/\Q$Le_tout\E/$Le_then/s;
}
else
{
$buffer =~ s/\Q$Le_tout\E/$Le_else/s;
}
}
else
{
affiche("Erreur de syntaxe pour l'objet MP.IF: $Le_if\n");
exit;
}
$buffer =~ s/SAPI\.IF/PM.IF/gs;
}
else
{
affiche("Erreur de syntaxe pour l'objet MP.IF: $Le_if\n");
exit;
}
}
else
{
if(($Le_if && ($Le_test =~ /^EXIST$/i)) || ($Le_if eq '' && ($Le_test =~ /^NOEXIST$/i)))
{
$buffer =~ s/\Q$Le_tout\E/$Le_then/s;
}
else
{
$buffer =~ s/\Q$Le_tout\E/$Le_else/s;
}
$buffer =~ s/SAPI\.IF/PM.IF/gs;
}
}
}
return $buffer;
}
###################
#
# Fonction principale
#
###################
sub main
{
# Il faut distinguer l'aspet d'habillage brut contenant des objet a resoudre
# Et l'habillage net contenant des objets resolus
#
# Exemple d'habillage brut :
#
#
# <- Objet a resoudre
#
#
#
#
# Exemple d'habillage net :
#
#
# ![]()
<- Objet resolu
#
#
#
# print "En entree : @ARGV
\n";
$debug = 0;
local ($Externe) = 0;;
local (%habillage_brut);
local (%Objet_html);
local (%Mes_Liens);
local(%Les_Liens_Of_Info) = ();
local(@Les_Langues_Suf) = [];
local(%Les_Langues_H) = ();
local ($flag_habillage) = 0;
local ($Le_Modele,@page_name);
$flag_habille = 0;
$sauve = $/;
#
# Lecture des options
#
if(@ARGV < 1 || $ARGV[0] =~ /-(h|\?)/)
{
print <filtre : $Filtre_fichier") if ($debug);
}
if($option =~ /.*p.*/is)
{
$Parallele = $ARGV[$i_arg];
$i_arg++;
$Habillage_file .= "_$Parallele";
$Original .= "_$Parallele";
$Obj_brut_dest .= "_$Parallele";
$Obj_net_dest .= "_$Parallele";
$Parallele_partie = $ARGV[$i_arg];
$Parallele_partie =~ s/_SEPHAB_//g;
if($Parallele_partie =~ /(.*)_BIGSEPHAB_(.*)/)
{
$Parallele_partie = $1;
$Parallele_not_partie = $2;
}
@Parallele_oui = split(//,$Parallele_partie);
@Parallele_non = split(//,$Parallele_not_partie);
$i_arg++;
&aff_debug("-->autre habillage : $Parallele") if ($debug);
&aff_debug("-->autre habillage (partie) : $Parallele_partie") if ($debug);
&aff_debug("-->autre habillage (not partie) : $Parallele_not_partie") if ($debug);
}
# On doit traiter les fichiers a creer
# ex: test -> test.html ou test.sgml ou test.fr.html et test.en.html, etc
local ($i_page) = 0;
local ($path_initial) = $path;
while($ARGV[$i_arg])
{
&aff_debug("-->$ARGV[$i_arg]") if ($debug);
$File_name = $ARGV[$i_arg];
if(!($File_name =~ /^$Source.*$/))
{
# print "-->$path\n";
if($Externe != 1 && $File_name =~ /^(.+?)$Source.*$/)
{
$Source = $1.$Source;
$Dest = $1.$Dest;
# $Externe = 1;
$path = $Source;
}
elsif($path ne "")
{
$File_name = "$path_initial/$File_name";
if($Externe != 1 && $File_name =~ /^(.*?)$Source.*$/)
{
$Source = $1.$Source;
$Dest = $1.$Dest;
# $Externe = 1;
$path = $Source;
}
else
{
affiche ("Le script habille.pl ne peut travailler dans cette arborescence\n");
exit;
}
}
}
# elsif(!($File_name =~ /^$Source.*$/))
# {
# print ":$File_name\n";
# }
if(!(-e $File_name) && $File_name)
{
local $fils_ls = "";
$File_name =~ s/\.(\+|\*)$//is;
#Si le fichier comporte un chemin absolu, alors
#Ce n'est pas la peine d'en rajouter (en musique!)
if($File_name =~ /^$Source.*/i)
{$file_ls = "$File_name.*";}
else
{$file_ls = "$path/$File_name.*";}
# print "=-=>$file_ls\n";
@list_fic = `ls $file_ls 2>/dev/null`;
$i_liste_fic = 0;
local($flag_file) = 0;
while($list_fic[$i_liste_fic])
{
$list_fic[$i_liste_fic] =~ s/\n*$//is;
if($list_fic[$i_liste_fic] =~ /.*\.(html|sgml|js2?)/is)
{
$Rep_min = &rep_min($Rep_min,$list_fic[$i_liste_fic]);
$page_name[$i_page++] = &replace($list_fic[$i_liste_fic],$Externe);
$flag_file = 1;
}
$i_liste_fic++;
}
if($flag_file == 0)
{affiche("Le fichier $File_name n'existe pas\n\n")}
}
else
{
if(!($File_name =~ /^$Source.*/i))
{$File_name = "$path/$File_name";}
$Rep_min = &rep_min($Rep_min,$File_name);
$page_name[$i_page++] = &replace($File_name,$Externe);
}
if($page_name[$i_page - 1] eq '')
{$i_page--;}
$i_arg++;
}
$Rep_min =~ s/\/+/\//g;
&aff_debug("Voici le rep min : $Rep_min") if ($debug);
$Rep_min =~ s/(.*)\/$/$1/;
if ($Rep_min)
{
if($Rep_min =~ /^$First_Source(.*)/)
{
$Rep_min = $1;
}
#print "($Source) avant ==> $path\n";
if($Source =~ /^$path.*/ || $path =~ /^$Source.*/)
{
if($path =~ /(.*)$Rep_min.*/)
{$path =~ s/(.*)$Rep_min.*/$1$Rep_min/s}
else
{$path .= "/$Rep_min"}
}
else
{
$path = "/$Rep_min";
}
local($i_page) = 0;
while($page_name[$i_page])
{
$page_name[$i_page] =~ s/\/+/\//g;
$page_name[$i_page] =~ s/^.*?$Rep_min//;
$page_name[$i_page] =~ s/^\///;
# print "===>$page_name[$i_page]\n";
$i_page++;
}
}
else
{
local($i_page) = 0;
while($page_name[$i_page])
{
$page_name[$i_page] =~ s/\/+/\//g;
$page_name[$i_page] =~ s/^$path//;
$page_name[$i_page] =~ s/^\///;
$i_page++;
}
}
if($i_page == 0 && !($option =~ /.*(r|d|v|t).*/))
{exit}
if($option =~ /.*v.*/is)
{
print "\n$Version\n\n";
exit;
}
if(!($path =~ /^$Source.*/))
{
if($path =~ /^(.*?)$Source.*/)
{
$Source = $1.$Source;
$Dest = $1.$Dest;
}
else
{
$path = $Source.$path;
}
}
&aff_debug("Path ==> $path") if ($debug);
&aff_debug("===>$page_name[0]") if ($debug);
if(!($path =~ /(^.*$Source)(.*)/))
{
affiche("Le script habille.pl ne peut travailler dans cette arborescence\n");
exit;
}
if (!-e $path){affiche(" L'arborescence\n-->$path N'est pas reconnu\nDemandez conseil a Pierre Cordani\n");exit}
#$test = $Source;
$test = $1;
$inf = $2;
$inf =~ s|^/||;
@rep = split(/\//,$inf);
local ($i_test) = 0;
local ($swap) = 0;
# Cette boucle me permet de lire les fichiers modeles et objets
# des couches supperieures
if(($option =~ /.*u.*/) && (-e "$path/$Obj_brut_dest"))
{
affiche("$path\n");
local($path_to_verif,$path_buf,$out) = ($path,$Source,0);
$path_to_verif =~ s/^$Source(.*)/$1\//;
while($path_to_verif =~ /^(.*?\/).*$/)
{
local ($r) = $1;
$path_to_verif =~ s/^$r//;
if((-e $path_buf.$r.$Habillage_file && -e $path."/".$Obj_brut_dest) && (-M $path_buf.$r.$Habillage_file < -M $path."/".$Obj_brut_dest))
{
print "Le .obj compile doit etre refait a cause de $path_buf$r$Habillage_file\n";
$option =~ s/u/o/g;
$out = 1;
last;
}
$path_buf .= $r;
}
if(!$out)
{
(*Objet_html,*habillage_brut,*Les_Langues_Suf,*Les_Langues_H) = lecture_final($path);
$flag_habille = -1;
}
}
else
{
# print "super";exit;
$option =~ s/u/o/g;
}
while($rep[$i_test] || $i_test == 0)
{
if($swap == 0)
{
if($rep[$i_test] eq ''){$i_test++}
$swap = 1
}
else
{
$test .= "/$rep[$i_test++]"
}
# print "$test<=\n";
# Ici on lit le fichier contenant le squellette de pages a creer
if(-e $test."/".$Original)
{
#On traite le fichier Modele
affiche("Je lis $test/$Original\n");
$sauve = $/;
undef $/;
open(MODELE,$test."/".$Original);
$Le_Modele = ;
close (MODELE);
$/ = $sauve;
}
# Ici on lit le fichier contenant les Liens
if(-e $test."/".$Liens)
{
affiche("Je lis $test/$Liens\n");
(*Mes_Liens,*Les_Liens_Of_Info) = &make_liens($test);
}
else
{
%Les_Liens_Of_Info = ();
%Mes_Liens = ();
}
if((-e $test."/".$Habillage_file) && ($flag_habille != -1))
{
# On traite le fichier d'habillage
affiche("Je lis $test/$Habillage_file\n");
(*habillage_brut,*Les_Langues_Suf,*Les_Langues_H) = &lecture_habillage($test."/".$Habillage_file,{%habillage_brut});
$flag_habille = 1;
}
}
if($flag_habille == 1)
{
# On genere l'habillage recursif
# print "Habillage net\n";
*Objet_html = &dispersion_habillage({%habillage_brut});
}
if($option =~ /.*o.*/is)
{
&ecriture_obj({%habillage_brut},{%Objet_html},$path);
}
#On genere les pages html avec l'habillage correspondant
# &debug_lien({%Mes_Liens});
$i_page = 0;
if($option =~ /.*(r|d).*/ && $page_name[0] eq '')
{
$page_name[0] = "/";
}
while($page_name[$i_page])
{
$Rep_courant = "$Source/$Rep_min";
$new_path = "$path/$page_name[$i_page]";
$new_path =~ s/\/+/\//isg;
#print "gestion de $new_path ($path) et ($page_name[$i_page])\n";
&transfert($new_path,{%habillage_brut},{%Objet_html},{%Les_Liens_Of_Info},[@Les_Langues_Suf],{%Les_Langues_H},$Le_Modele,$option,copy_hash_of_hash[%Mes_Liens]);
$i_page++;
}
if($File_Cont == 0)
{print ""}
affiche ("Nombre de fichiers traites: $File_Cont\n");
if($File_Cont == 0)
{print ""}
exit;
}