#!/usr/bin/perl
#use strict;
use File::Copy;
#
#
# hache for "production de pages HACHEtéhélémisées"
#
# by Jean-Baptiste DENIS
#
# (see _DATA_ section (and code) for details)
#
#
#
################### variate initialisations #################
#
#$version = "0.1 (10 avril 2002)";
#$ver = "[0.50; May 25, 2002]";
$ver = "[0.52; September 02, 2002]";
($jour,$mois,$an) = (localtime)[3,4,5];
$mois++; $an = $an + 1900;
$date = $an."/".$mois."/".$jour;
$maintenant = localtime;
$pf = "";
$tampon_entree = "e.cah";
$tampon_sortie = "s.cah";
$sp = ".";
$sep = ";;";
$debpar = "
"; $finpar = "
";
#
# following initializations must be adapted
# from a user to another one
#
# the name
$nom{i} = "Jean-Baptiste DENIS";
$nom{s} = "JBD";
$nom{f} = "Jeanie et Jean-Baptiste DENIS";
$nom{g} = "Jean-Baptiste DENIS";
$nom{p} = "J-B DENIS";
#
# the e-mail
$mel{i} = "jbdenis\@jouy.inra.fr";
$mel{s} = "jbdenis\@sinerj.org";
$mel{f} = "jjbdenis\@wanadoo.fr";
$mel{g} = "jbdjbd\@voila.fr";
$mel{p} = "";
#
################### functions #######################
#
### writing a message in log before dying
sub didi {
print LOG $_[0];
die($_[0]);
}
### reading the parameters from a file
sub fileparameters {
open(ARGU,"".$_[0]) || &didi ("hache(1): can't access to file \"".$_[0],"\"");
@argu = ();
while() {
chop;
while ($_ =~ /^ /) {$_ = substr($_,1);}
@argu = (@argu,split(/ +/,$_));
}
close(ARGU);
}
### checking and transforming the arguments
sub consisparameters {
$nbae = int(scalar(@argu) / 2);
if (scalar(@argu) != 2 * $nbae) {&didi("hache(2): ".scalar(@argu)." is a bad number of arguments (must be even)!")}
for ($na = 0; $na < $nbae; $na++) {
if (substr($argu[2*$na],0,1) ne "-") {
&didi("hache(3): missing \"-\" for argument type number ",$na+1,": sorry we were asked to be strict!");
}
$argu[2*$na] = substr($argu[2*$na],1);
# is parameter file asked?
if ($argu[2*$na] eq "pf") {$pf = $argu[1+2*$na];}
}
}
### normalizing the options
sub normaoptions {
while (($k,$v) = each %argu) {
$aaa = "&checkcheck(@".$k.");";
eval $aaa;
if ($bbb) {
$aargu = "&checkoption(\"".$k."\",\"".$v."\",@".$k.");";
eval $aargu;
}
}
}
### check if the check must be done
sub checkcheck {
if (scalar(@_) == 0) { $bbb = 0;}
else { $bbb = 1;}
}
### checking one options
sub checkoption {
my ($jbd,$check);
$check = 0;
for ($jbd = 2; $jbd <= $#_; $jbd++) {
if ($_[1] eq $_[$jbd]) { $check = 1;}
}
if ($check == 0) {
$argu{$_[0]} = $_[2];
print LOG "WARNING: option ",$_[0]," wrong (",$_[1],") forced to its default value: ",$_[2],"\n";
print "WARNING: option ",$_[0]," wrong (",$_[1],") forced to its default value: ",$_[2],"\n";
}
}
### selecting the files
sub selec {
$selec = 0;
if ($_[0] =~ /$sp.$argu{hac}$/) { $selec = 1;}
}
### transforming a given line of the original html file
sub transfo {
$lig = $_[0];
if ($argu{sty} eq "c") {
$lig =~ s/
/$he[0]/;
$lig =~ s/
/$he[1]/;
$lig =~ s/
/$he[2]/;
$lig =~ s/
/$he[3]/;
$lig =~ s/
/
/;
$lig =~ s/
/
/;
$lig =~ s/
/$pa/;
$lig =~ s//$pa/;
$lig =~ s/
".$titre."
";
}
### identification of a html page
sub body {
my $fh = $_[0];
if ($argu{sty} ne "c") { print $fh "";}
else {
if ($argu{image} eq "no image") {
print $fh "";
}
else {
print $fh "
";
}
}
}
### identification of a html page
sub bandeau {
my $fh = $_[0];
if (($argu{typ} ne "ia") && ($argu{typ} ne "ie")) {
if ($argu{sty} eq "c") { print $fh "
";}
else { print $fh "
";}
print $fh "Page ".$destyp{$argu{typ}}."
";
}
print $fh $bandeau{$argu{typ}};
}
### identification of a html page
sub chausse {
my $fh = $_[0];
print $fh $chausse{$argu{typ}};
}
### identification of a html page
sub identification {
my $fh = $_[0];
if (($argu{typ} ne "ia") && ($argu{typ} ne "ie")) {
if ($argu{sty} eq "c") { print $fh "
";}
else { print $fh "
";}
print $fh "généré le ".$date." par ".$argu{hache}.", à partir de ".$fentree." (initié le ".$date_c." modifié le ".$date_m.") suivant le style ".$argu{s2}."
\n";
}
}
### foot of a html page
sub fin {
my $fh = $_[0];
print $fh "";
}
### reading page parameters
sub param {
local($ligne,$para,$sep,@param);
open(ENTREE,$tampon_entree);
# détermination de l'emplacement du 1er paragraphe
# et lecture
# $. = 0; à quoi cette instruction peut-elle servir ???
do { $ligne = } until (index($ligne,$debpar)>=0) || eof;
if (index($ligne,$debpar) == -1) { return(undef)}
chop($ligne); $para = $ligne;
if (index($ligne,$finpar) < 0) {
do { $ligne = ; chop($ligne); $para = $para . " " . $ligne;}
until (index($ligne,$finpar)>=0) || eof;
if (index($ligne,$finpar) == -1) { return(undef)}
}
# préparation du 1er paragraphe
$para = substr($para,index($para,$debpar)+length($debpar));
$para = substr($para,0,index($para,$finpar));
$para =~ s/^\s+//;
$para =~ s/\s+$//;
# découverte du séparateur à utiliser
$sep = substr($para,0,index($para," "));
# réajustage de la chaîne paragraphe
$para = substr($para,index($para,$sep)+length($sep));
$para =~ s/^\s+//;
# décodage des paramètres et renvoi
@param = split(/$sep/,$para);
if (@param < 3) {
didi("hache(4) : wrong number of parameter in file ".$tampon_entree." copied from ".$fentree."!\n");
}
($titre,$date_c,$date_m,$auteur,$mel) = (@param[0..2],$nom{$argu{des}},$mel{$argu{des}});
@motsclef = ();
if ($type eq "i") { @motsclef = ("INRA","BIA","Jouy-en-Josas","BIA-Jouy");}
if ($type eq "s") { @motsclef = ("GlobeNet","Siner'J","forum des jeunes et des îles","Guyancourt");}
if ($type eq "p") { @motsclef = ("jbd");}
if (@param > 2) {@motsclef = (@motsclef,@param[3..$#param]);}
close(ENTREE);
}
#
################### formats #########################
#
format arguments =
@>>>>>>>>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
"-".$k,$v
.
format fichiers =
@>>>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
"(".$nbfi.")",$fifi
.
format copies =
@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$origi,$copy1
.
format deletions =
@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
$origi
.
#
################### interpreting the parameters #########################
#
#
# description of the different types of pages
#
$destyp{id} = "diffusion pour INRA";
$destyp{sd} = "diffusion pour Siner'J";
$destyp{fd} = "diffusion pour la famille";
$destyp{gd} = "diffusion générale";
$destyp{pd} = "diffusion jbd";
$destyp{ia} = "Intranet pour BIA-Jouy";
$destyp{ie} = "Internet pour BIA-Jouy";
$destyp{ip} = "pages Internet personnelles INRA";
$destyp{sp} = "pages Internet personnelles Siner'J";
$destyp{iq} = "notes personnelles INRA";
$destyp{sq} = "notes personnelles Siner'J";
$destyp{fq} = "notes personnelles famille";
$destyp{ig} = "LogUni";
$destyp{sg} = "Forum des Jeunes et des Îles";
$destyp{im} = "manuel pour INRA";
$destyp{sm} = "manuel pour Siner'J";
$destyp{gm} = "manuel général";
### greeting
print "-"x50,"\n\n";
print " <<< hache >>> version $ver \n\n";
print "-"x50,"\n\n";
### decoding the parameters
### no parameters
if ($#ARGV < 0) { while () { print; } exit; }
### one parameter
if ($#ARGV == 0) {
### default values
if ($ARGV[0] eq "default") {
@argu = ();
}
### reading the parameters from a file
else {
if ($ARGV[0] eq "?") {
print "\n\n Les différents \"-typ\" prévus\n --------------------------\n\n";
foreach $k (sort keys %destyp) { print $k," : ",$destyp{$k},"\n" ;}
print("\nA toi de jouer :");
goto FIN;
}
else {
&fileparameters($ARGV[0]);
&consisparameters;
}
}
}
### taking them from the command line
else {
@argu = @ARGV;
@argv = @argu;
&consisparameters;
### possibly reading a parameter file
if ($pf ne "") {
&fileparameters($pf);
push(@argu,@argv);
&consisparameters;
}
}
############################################################################
############################################################################
### loading the default arguments and commenting the other possibilities ###
############################################################################
############################################################################
### first is given the default value, then the list of possible values
### the fist component of the list must be the default value
### no @* means that the option is free (name of a file for instance)
$argu{pf} = "";
# name of the parameter file; "" means there is no
$argu{hac} = "hac";
# the suffix of input files
$argu{f} = ".";
# directory from where the transformations must be applied
$argu{t} = $argu{f};
# directory where resulting are placed
$argu{des} = "i"; @des = ("i", # INRA context
"s", # SinerJ context
"f", # family context
"g", # general context
"p");# personal context
# destination of the produced pages ; for the moment this parameter
# governs the coloration of the main different structures and partly the
# signature.
$argu{use} = "d"; @use = ("d", # for standard diffusion
"p", # for personal pages (for intra/internet)
"q", # for personal pages (to read by myself)
"g", # for the team in which, I work
"a", # for intranet pages
"e", # for internet pages
"m");# for manual production
# use of the produced pages. This parameter is not directly used
# for defining the format of the page.
$argu{typ} = $argu{des}.$argu{use}; @typ = ("id","sd","fd","gd","pd",
"ip","sp",
"iq","sq","fq",
"ig","sg",
"ia",
"ie",
"im","sm", "gm");
# type of pages, obtained by combining destination and use
# not all combinations are allowed. Personal signatures and
# reference tables are determined from it.
$argu{sty} = "r"; @sty = ("r","c");
# either reduced (= no sophisticated format options to allow old browsers
# to read and print the pages without difficulty)
# or complete.
$argu{s1} = "html";
# suffix of the html produced pages (-1rst component)
$argu{s2} = $argu{typ}.$argu{sty};
# pre-suffix of the produced html pages (-2d component)
$argu{os} = "linux"; @os = ("linux","unix","msw");
# name of the operating system ("msw" for MicroSoftWindows)
$argu{log} = "hache.log";
# name for the log file (placed in the result directory)
# when "", no log file is generated
$argu{hache} = "hache ".$ver." "." (script écrit en Perl)";
# reference to hache
$argu{image} = "no image";
# possibly for a file fiving a background image
### overloading the default arguments
$typ = 0;
for ($na = 0; $na < $nbae; $na++) {
$argu{$argu[2*$na]} = $argu[1+2*$na];
if ($argu[2*$na] eq "typ") { $typ = 1;}
}
$sl = "/";
if ($argu{os} eq "msw") {
$sl = "\\";
}
### preparing the resulting directory
if (!opendir(ARRIV,$argu{t})) {
mkdir($argu{t},777) || &didi("hache(5): can't create directory \"".$argu{t}."\"");
opendir(ARRIV,$argu{t}) || &didi("hache(6): can't access directory \"".$argu{t}."\"");
}
closedir(ARRIV);
### preparing the log file
open(LOG,">".$argu{t}.$sl.$argu{log}) || &didi ("hache(7): can't create to ".$argu{t}.$sl.$argu{log});
print LOG "log file ".$argu{t}.$sl.$argu{log}."\n\n";
print LOG "-"x50,"\n\n";
print LOG " <<< hache >>> version $ver \n";
print LOG " used at ",scalar(localtime()),"\n\n";
print LOG "-"x50,"\n\n";
### normalizing the choosen options
&normaoptions;
### some peculiar adjustments
if ($typ == 0) {
$argu{typ} = $argu{des}.$argu{use};
}
&normaoptions;
$argu{s2} = $argu{typ}.$argu{sty};
### printing the arguments in the log file
$oldhandle = select(LOG); $~ = "arguments"; select($oldhandle);
print LOG "\n Arguments Retained:","\n ","-"x19,"\n\n";
while (($k,$v) = each %argu) { write LOG;}
################### selecting the files #######################
#
### preparing the selection
print LOG "\n\n Found Files in \"",$argu{f},"\":","\n ","-"x(18+length($argu{f})),"\n\n";
opendir(DEPART,$argu{f}) || didi("placo(7): can't access directory ".$argu{f});
@fiori = (); $nbfi = 0;
$oldhandle = select(LOG); $~ = "fichiers"; select($oldhandle);
### performing the selection
while($fifi = readdir(DEPART)) {
&selec($fifi);
if ($selec) {
$nbfi++;
push(@fiori,$fifi);
write LOG;
}
}
#
# modifying the various items according to the type
#
#
# The 4 components of @heading are destined to respectively replace "
", "" & "
"
#
$heading{i} = ("
".$sep.
"
".$sep.
"
".$sep.
"
");
$heading{s} = ("
".$sep.
"
".$sep.
"
".$sep.
"
");
$heading{f} = ("
".$sep.
"
".$sep.
"
".$sep.
"
");
$heading{g} = ("
".$sep.
"
".$sep.
"
".$sep.
"
");
$heading{p} = ("
".$sep.
"
".$sep.
"
".$sep.
"
");
#
# The first 3 components of @color are destined to respectively give
# the background color argument of , and
;
#
# then the fourth one is the font colour for some advertisement messages
#
$color{i} = ("\#FFEEFF".$sep."\#FFE5FF".$sep."#FFDDFF".$sep."#33FF33");
$color{s} = ("\#EEFFFF".$sep."\#E5FFFF".$sep."#DDFFFF".$sep."#FF0F0F");
$color{f} = ("\#FFFFEE".$sep."\#FFFFE5".$sep."#FFFFDD".$sep."#0F0FFF");
$color{g} = ("\#EEEEFF".$sep."\#E5E5FF".$sep."#DDDDFF".$sep."#FFFF0F");
$color{p} = ("\#FFFFFF".$sep."\#EEEEEE".$sep."#E5E5E5".$sep."#777777");
#
# loading
#
$type = substr($argu{typ},0,1);
@he = split($sep,$heading{$type});
@co = split($sep,$color{$type});
$pa = "
";
$ta = "
",$fsortie," (",$nbfile,")\n";
print $fentree," --> ",$fsortie," (",$nbfile,")\n";
copy($fentree,$tampon_entree) or didi("hache(8): file ".$fentree." not found!\n");
chmod(0600,$tampon_entree);
# decoding parameters: first pararaph of the input file
¶m;
#
# different types of front pages
#
$bandeau{ia} =
"
";
$bandeau{ie} = $bandeau{ia};
$bandeau{id} = "";
$bandeau{sd} = "";
$bandeau{fd} = "";
$bandeau{gd} = "";
$bandeau{pd} = "";
$bandeau{ip} = "à faire";
$bandeau{sp} = "à faire";
$bandeau{iq} =
"
";
$chausse{im} = "";
$chausse{sm} = "";
$chausse{gm} = "";
#
# writing the curent file
#
open(SORTIE,">$tampon_sortie");
open(ENTREE,$fentree);
&debut(SORTIE);
&body(SORTIE);
# writing the front page
&bandeau(SORTIE);
# parameter paragraph must be the first and on a unique record?
do { $ligne = ;} until (index($ligne,$finpar)>=0) || eof;
if (index($ligne,$finpar) >= 0) {
$ligne = substr($ligne,index($ligne,$finpar)+length($finpar));
$ligne = &transfo($ligne);
print SORTIE $ligne;
while () {
$_ = &transfo($_);
$fini = index($_,"");
if ($fini != -1) { $_ = substr($_,0,$fini);}
# writing record
print SORTIE $_;
if ($fini != -1) { last;}
}
}
&chausse(SORTIE);
&identification(SORTIE);
&fin(SORTIE);
close(SORTIE);close(ENTREE);
chmod(0600,$fsortie);
unlink $fsortie;
copy($tampon_sortie,$fsortie);
# placement des modes logiques
chmod(0444,$fsortie);
chmod(0600,$fentree);
# destruction des fichiers tampons
unlink $tampon_entree,$tampon_sortie;
}
FIN: print " hache a fini \n";
__DATA__
--<<( PROJET "hache" )>>--
<< Introduction >>
For the moment, "hache" is no more than a personal procedure. A lot of
jbd's features are included into the code. In future version,
something has to be done to allow other user to easily implement their
own preferences.
<< Aim >>
To generate from very standard html pages, derived html pages with a
similar style.
By default, all <*.hac> files of a given directory are considered
as original html pages
<< Arguments >>
They are dealt in a similar way that in placo.
"hache ?" gives the list of the recognized style
"hache default" runs hache with all default values
"hache file" runs hache with values given in file "file"
just one example
hache -f -t -typ id -sty c -os msw
<< page arguments >>
within the page, it is compulsory to put at least three arguments to
fill some pieces of information into the transformed html pages
(1) title,
(2) creation date aaaa/mm/dd
(3) last modification date aaaa/mm/dd
(4...) keywords as many as wanted
This argument must be given in the first paragraphe of the original
page separated by any string separator that the user defined before
the first argument.
To give one example :
&&& Speech by the dean &&& 2000/07/01 &&& 2001/02/28 &&& university
<< To be done >>
(*) Permettre que la transformation s'applique à l'ensemble des
sous-répertoires d'un répertoire.
(*) Réfléchir à un meilleur partage du code entre les différentes
transformations.
(*) faire une exception pour la dénomination des pages d'accueil,
c'est à dire que les fichiers "welcome.hac" et "index.hac" soient
transformés en "welcome.html" et "index.html" (avec un
commentaire à l'intérieur, qui pourrait être systématique
indiquant le numéro de la version employée.
(*) ???
<< Remarques d'utilisation >>
Lorsqu'un blanc ne suit pas le séparateur en début, alors il déclare un mauvais nombre de paramètre... Que faire pour éviter le piège ?
incorporer une image de fond pour certains styles (option à rajouter)
<< Commentaires >>
Toutes suggestions, réactions, commentaires seront appréciés, merci de
les envoyer à "jbdenis@jouy.inra.fr".