#!/usr/bin/perl -w #le programme suppose # que chaque commande tient sur une ligne, et que y a pas d'accolades imbriqu\'ees # dans les commandes # et qu'il y a au plus une commande par ligne my @liste_categories=('AnglePedagogique','Niveau','Theme','Auteur','Date'); #les categories rentrees dans le fichier tex my @liste_categories_calculees=('Longueur'); #ce sont les categories qu'on ne recherche pas dans le fichier tex mais qu'on calcule (typiquement Longueur). my %liste_categ_sec=( # le nom des commandes correspondant aux categ secondaires 'AnglePedagogique'=>'AnglesSecondaires', # ne pas en mettre si c'est inutilise. 'Niveau'=>'NiveauxSecondaires', 'Theme'=>'ThemesSecondaires', 'Auteur'=>'AutresAuteurs');#pas de Date secondaire my %liste_categories_sans_receuil=('Auteur'=>1,'Longueur'=>1);# la valeur est inutilisee. Si c'est defini: pas de receuil. my %liste_categories_non_precisees_a_chq_entree_d_index=('Longueur'=>1);# la valeur est inutilisee. Si 'Longueur' defini, #l'info 'Longueur' n'apparaitra pas dans les commande \ligneindex{titre}{theme}{auteur}... # le hash ``cle_tri'' dit comment remplir le champ servant a trier. # si ce n'est pas defini, on utilisera le meme mot. my %cle_tri=( '\DEUGi' => 'Niv1', # a gauche la commande latex (\DEUGi qui ecrira par exple ``Deug premiere annee'') # a doite la cle servant a trier (Niv1). '\DEUGii' => 'Niv2', '\DEUGbio' => 'Niv2bio', '\DEUGphys' => 'Niv2phys', '\Licence' => 'Niv3', '\Maitrise' => 'Niv4', '\Agreg' => 'Niv5', '\Autres' => 'ZZZZZZZZ', 'Autres' => 'ZZZZZZZZ', 'autres' => 'ZZZZZZZZ', '\Complexes' => 'Nombres Complexes', '\Ensembles' => 'Theorie des ensembles', '\AlgLin' => 'Algebre Lineaire', '\GeomEucl' => 'Geometrie Euclidienne', '\Fonctions' => 'Fonctions1', '\FonctionsPlusieursVars' => 'Fonctions2' ); my $commande_index='\ligneindex'; #pour ecrire une ligne standard, # on utilisera typiquement #\ligneindexTheme{titre}{nomfic}{categ1}{categ2}... my $commande_separation_index='\separationindex'; #ca c'est pour les sous-titre de l'index my $nom_fichier_tex='exos_par_'; #prefixe du nom des fichier tex standard my $nom_fichier_tex_nouveau='nouveaux_par_'; #prefixe du nom des fichier tex pour les nouveaux/par date my $nom_fichier_index='index_' ; my $prefixe_label=''; # les exercices sont labelles avec "$prefixe_label$nomfic" dans l'index my @liste_repertoires=('fred','vincent'); my $http='http://www-fourier.ujf-grenoble.fr/~guirarde/EXEMAALT/exos_individuels/pdf_navigable'; # utilise comme adresse dans liste-mail my $repertindiv='../../exos\_individuels'; # utilise pour le format html. Utilise a partir du repertoire EXEMAALT/exos_tries/html/ ##################################################################### ############ Variables globales (utilisees par les procedures) ###################################################################### # attention, pour une raison mysterieuse, il ne faut pas declarer les variables globales $a et $b # comme variables globales (sous peine que la reference ne passe pas). Il faut les laisser non declarees. my $nomfic; # a mettre avant match_accollades pour pouvoir retourner le message d'erreur # contenant le nom de fichier my $categ ; my $sens=1 ; #sens du tri = +-1 (-1 pour decroissant ie pour date) my (%tableau,%tableau_cles) ; # %tableau contient un pointeur (=reference, voir `man perlreftut') # pour chaque exo qui pointe vers un hash # dont les indices sont niveau, theme, anglepedagogique etc. # pour chaque exo on stocke ainsi toute les infos utiles dans ce tableau. #exemple typique: $tableau{'cristaux'}->{'niveau'} contient le niveau du fichier cristaux # Meme structure pour tableau_cles, qui contient les cles selon lesquelle on doit trier # (typiquement, si ordre different de l'ordre alphabetique). #on stocke aussi la dedans le fait que l'exo est un fichier unique (figures...) ou pas: # $tableau{$exo}->{'Fichier_Unique'} vaut 0 ou 1 selon le cas my (%trie_par,%index_par); # trie_par est un hash indexe par les categories. # trie_par{niveau} est une reference qui pointe vers un tableau # qui contient la liste des noms des exos tries par niveau # Chaque niveau apparait une seule fois. # Tout ca pour creer le fichier tex dans l'ordre. #idem pour index_par sauf que c'est pour faire les tables des matieres. # Pour creer les tables des matieres avec references multiples a un meme fichier, # on utilise 4 tableaux: %cles_sec (cles secondaires), %categ_sec, %tableau_officiels # et %nom_sec (nom du fichier associe) # typiquement $categ_sec{niveau}->[36] contient \Licence (36 est un numero arbitraire) # $cles_sec{niveau}->[36] contient Niv3 # $tableau_officiels{niveau}->[36] contient 0 ou 1 selon que le niveau est officiel ou pas # et $nom_sec{niveau}->36 contient Cristaux, ce qui signifierait que l'un des niveaux # de l'exo Cristaux est la Licence. # on utilise push pour ajouter un nouvel element a ce tableau. my (%cles_sec,%nom_sec,%categ_sec,%tableau_officiels); sub desaccentuation ($) { # prend un argument = une chaine de caractere, et remplace # les caracteres accentues (tex ou iso) par les carac non accentues corresp my $chaine = shift ; my %table_caracteres = ( "\\\`a" => 'a', "\\\`{a}" => 'a' ,"à" => 'a', "\\\"a" => 'a', "\\\"{a}" => 'a' ,"ä" => 'a', "\\\^a" => 'a', "\\\^{a}" => 'a' ,"â" => 'a', "\\\'e" => 'e', "\\\`e" => 'e', "\\\^e" => 'e', "\\\"e" => 'e', "\\\'{e}" => 'e', "\\\`{e}" => 'e', "\\\^{e}" => '{e}', "\\\"e" => 'e', 'é' => 'e', 'è' => 'e', 'ê' => 'e', 'ë' => 'e', "\\\^\\i " => 'i', "\\\^{\\i}" => 'i', 'î' => 'i', "\\\"\\i " => 'i', "\\\"{\\i}" => 'i', 'ï' => 'i', "\\\"o" => 'o', "\\\"{o}" => 'o' ,"ö" => 'o', "\\\^o" => 'o', "\\\^{o}" => 'o' ,"ô" => 'o', "\\\`u" => 'u', "\\\`{u}" => 'u' ,"ù" => 'u', "\\\"u" => 'u', "\\\"{u}" => 'u' ,"ü" => 'u', "\\\^u" => 'u', "\\\^{u}" => 'u' ,"û" => 'u', "\\c c" => 'c', "\\c{c}" => 'c', 'ç' => 'c' ); foreach $c ( keys %table_caracteres ) { $c2=$table_caracteres{$c}; $chaine =~ s/\Q$c\E/$c2/sg; }; return ($chaine); }#fin de desaccentuation # on declare la procedure en avance pour que perl ne se plaigne pas de ne pas connaitre # le prototype lors de son appel (procedure recursive) sub match_accollades($); ############################################################ sub match_accollades($) { #prend un argument = une ligne (supposement precedee par '{') #retourne deux chaines: la premiere est ce qui va jusqu'a #l'accollade fermante correspondante. #la deuxieme est ce qui suit la premiere chaine # si l'accollade fermante correspondante n'est pas sur cette #ligne, il lit des lignes supplementaires dans le fichier ### Exemple : match_accolades ( "coucou{lala}je suis la}ciao{bonsoir" ) # retourne "coucou{lala}je suis la" et "ciao{bonsoir" ######################### my $ligne=shift ; my ($gauche, $droite, $sous_expr, $suite, $a_inclure); my ($cles,$commande); #a_inclure memorise la partie deja parcourue qu'il faut inclure dans la # premiere chaine a retourner (ce qui entre les accollades en question) $a_inclure=''; do { if ( $ligne =~ m/(^)\{(.*)$/o #la ligne commence par un '{' or $ligne =~ m/(^(?:.*?[^\\]))\{(.*)$/os ) # ou si il y a un '{' non precede par un '\' { $gauche=$1 ; $droite=$2 ; #ligne = $gauche."\{".$droite if ( $gauche =~ m/^()\}(.*)$/o # si la $gauche commence par '}' or $gauche =~ m/^(.*?[^\\])\}(.*)$/o ) #ou si il y a un '}' #avant le '{' trouve precedemment, on a fini. { $a_inclure="$a_inclure$1" ; $suite="$2\{$droite" ; return ($a_inclure, $suite) ; } else { # si on est ici, c'est qu'il y n'a pas de '}' avant le premier '{' et il faut recurrer ($sous_expr,$suite)= match_accollades($droite) ; $a_inclure="$a_inclure$gauche\{$sous_expr\}" ; $ligne=$suite ; }; } else {#si il n'y a pas de '{' if ( $ligne =~ m/(^)\}(.*$)/o # si il y a un '}' au debut or $ligne =~ m/(^.*?[^\\])\}(.*$)/o ) {#si il y a un '}' on a fini $a_inclure="$a_inclure$1" ; return ($a_inclure, $2) ; } else { # si il n'y a ni '{' ni '}' il faut lire du stdin $a_inclure="$a_inclure$ligne"; ( defined($ligne=) ) or die ("erreur lecture du fichier tex dans match_accollade\n"); } } } while ( 1==1 ) ; }# fin de la procedure match_accollades ######################################################################## sub seuil($){# prend un nombre (2548 par ex) et lui associe le nombre de la forme 10^n, 2*10^n, 5*10^n juste en dessous (ici 2000) my ($x,$c,$s,$seuil); $x=shift; $s=sprintf("%u",$x); if ($s !~ m/(\d)\d*/o){die "seuil appele avec chiffre bizarre: $s\n";} else {$c=$1;}; # $c = premier chiffre $l=length($s)-1; if ($c==1){$seuil=(10**$l);} elsif (($c>=2) and ($c<5)) {$seuil=2*(10**$l);} else {$seuil=5*(10**$l);}; return($seuil); } sub compare_categ($$){ # compare 2 arguments. Utilisee par compare_index et compare_principal. Dit essentiellement quand mettre une separation. # renvoie +2 ou -2 si on doit mettre une separation entre les 2 (en general lorsque categ differente) # sinon +1 ou -1. # pour les dates, c'est different: on renvoie +-2 si c'est des mois differents # (on fait des separations tous les mois) # pour les durees: toujours +-1. my ($comp,$cle1,$cle2); $cle1=uc(shift); $cle2=uc(shift); if ($categ ne 'Date') { $cle1 =~ s/[^\w]//og ; # On enleve les caracteres non alphabetiques pour le tri (pour que \`elephant soit apres abruti) $cle2 =~ s/[^\w]//og ; if ($categ ne 'Longueur') { $comp= 2*( $cle1 cmp $cle2 )} else { $comp= 2*( seuil($cle1) <=> seuil($cle2) ) or $comp= ( $cle1 <=> $cle2 )} ; # comparaison numerique. } else {#si $categ eq 'Date' ($an1,$mois1,$jour1)=split(/\//,$cle1); ($an2,$mois2,$jour2)=split(/\//,$cle2); $comp= 2*($an1 <=> $an2); if ($comp==0) { $comp=2*($mois1 <=> $mois2) ;} if ($comp==0) { $comp=($jour1 <=> $jour2) ;} };# fin du if $categ ne 'Date' return($comp); }; #fin compare_categ ############################################################################### ######## Procedure de tri des categories secondaires (officiel/nonofficiel) ############################################################################### sub compare_index {#utilise les variables globales $a et $b #plus precisement on trie selon $cles_sec{$categ}->[$a] my $comp; # renvoie +4 ou -4 si sont d'officialite differente, # +2 ou -2 si on doit mettre une separation entre les 2 (en general meme officialite mais categ differente) # +1, -1 ou 0 si meme categ et meme officialite, selon ordre des titres. # pour les dates, c'est different: on renvoie +-2 si c'est des mois differents # (on fait des separations tous les mois) # +-1 selon le jour, puis selon le titre my $i1=$a; my $i2=$b; #print "$i1, $i2\n"; # on commence par mettre les officiels devant. $comp=4*($tableau_officiels{$categ}->[$i2] <=> $tableau_officiels{$categ}->[$i1]); if ($comp == 0 ) { $comp=compare_categ($cles_sec{$categ}->[$i1],$cles_sec{$categ}->[$i2]);}; if ($comp == 0 ) { my $exo1=$nom_sec{$categ}->[$i1]; my $exo2=$nom_sec{$categ}->[$i2]; my $titre1=uc($tableau{$exo1}->{'Titre'}); my $titre2=uc($tableau{$exo2}->{'Titre'}); $titre1 =~ s/[^\w]//og ; $titre2 =~ s/[^\w]//og ; $comp= ( $titre1 cmp $titre2 ) } $comp=$comp*$sens; #si $sens=-1 ca retourne l'ordre. return($comp); }; # fin de la procedure ############################################################################### ######## Procedure de tri des categories principales ############################################################################### sub compare_principal { #utilise les variables globales $a et $b my ($cle1,$cle2,$comp); $comp=compare_categ($tableau_cles{$a}->{$categ},$tableau_cles{$b}->{$categ}); # a categorie egale, on trie par titre if ($comp ==0){ $cle1 = uc($tableau{$a}->{'Titre'}) ; $cle2 = uc($tableau{$b}->{'Titre'}) ; $cle1 =~ s/[^\w]//og; #on enleve les caracteres non alphanumeriques $cle2 =~ s/[^\w]//og; $comp=($cle1 cmp $cle2); } $comp=$comp*$sens; #si $sens=-1 ca retourne l'ordre. return($comp); }; ############################################################################ ####### Programme principal ############################################################################ print "Creations des receuils et des index\n\n"; my ($titre,$reste_ligne,$resultat,$cle); my $sources=$ENV{SOURCES}; my $bin=$ENV{BIN}; my $date_nouveau=$ENV{DATE_NOUVEAU}; #date a partir de laquelle les exos sont marques NOUVEAU my $date_mail=$ENV{DATE_MAIL}; #date a partir de laquelle les exos sont listes dans liste_a_mailer.txt my @resultats;my $resultats_bruts; my %dejavu ; my $repertoire; my $exo_OK; my $annee; my $ajouter_annee_dans_exo; my $line; my ($fichier,$format); # Premiere partie: recuperation des donnees dans les exos. #On initialise dejavu a zero. $dejavu{'Titre'}=0; $dejavu{'titrebookmark'}=0; $dejavu{'Annee'}=0; # la commande annee sert au copyright. # elle est ajoutee dans le fichier par exos-make-tex a partir de la commande \Date @reste_categories=@liste_categories ; while($categ=shift(@reste_categories)){ $dejavu{$categ}=0 ; if (defined $liste_categ_sec{$categ}) { $dejavu{$liste_categ_sec{$categ}}=0 }; } #le premier while boucle sur les repertoires (fred et vincent) # le deuxieme sur les fichiers tex while ($repertoire= shift(@liste_repertoires)){ opendir(DIR, "$sources/$repertoire") || die "Erreur a l'ouverture du repertore $sources/$repertoire !"; # @liste_fichiers = grep { /.*\.tex$/ && -f "$sources/$repertoire/$_" } readdir(DIR); @liste_fichiers =(); CONSTRUCTION_LISTE_FICHIERS: foreach $repert_exo (readdir(DIR)) { if ($repert_exo =~ m/^\./o) {next CONSTRUCTION_LISTE_FICHIERS}; if ( -f "$sources/$repertoire/$repert_exo/$repert_exo.tex" ) { push @liste_fichiers, $repert_exo ; } else { die("le fichier $sources/$repertoire/$repert_exo/$repert_exo.tex n'existe pas\n"); }; }; closedir DIR; FICHIERS: while ($nomfic=shift(@liste_fichiers) ){ chdir "$sources/$repertoire/$nomfic" or die "Erreur chdir $sources/$repertoire/$nomfic"; # on remet tout a zero $exo_OK=0; $ajouter_annee_dans_exo=0; $dejavu{'Titre'}=0; $dejavu{'titrebookmark'}=0; $dejavu{'Annee'}=0; @reste_categories=@liste_categories ; while($categ=shift(@reste_categories)){ $dejavu{$categ}=0 ; if (defined $liste_categ_sec{$categ}) { $dejavu{$liste_categ_sec{$categ}}=0 }; } open FICHIER_TEX,"cat $nomfic.tex | ${bin}/enleve-commentaires-tex |" or die("erreur ouverture $nomfic\n"); if ( exists $tableau{$nomfic} ){ die "Le fichier $nomfic est present dans deux repertoires...\n"}; $tableau{$nomfic}->{'repertoire'}=$repertoire ; # on se souvient du repertoire ou se trouvait l'exo #on regarde si l'exo est un fichier unique (typiquement si y a pas de figure) ou pas #pour ca on teste le nombre de fichiers dans le repertoire de l'exo dont le nom ne finit pas par ~, et qui ne sont pas un repertoire nomme 'auto' #(cree par emacs) et qui ne commencent pas par . . opendir(DIR, "$sources/$repertoire/$nomfic") or die "Erreur a l'ouverture du repertore $sources/$repertoire !"; my @sous_fichiers= grep { -r "$sources/$repertoire/$nomfic/$_" && $_ !~/\~$/o && $_ !~/^\./o && !( -d "$sources/$repertoire/$nomfic/$_" && $_ =~/^auto$/o ) } readdir(DIR); my $nombre_sous_fichiers=$#sous_fichiers +1; if ($nombre_sous_fichiers==1){ $tableau{$nomfic}->{'Fichier_Unique'}=1;} else { $tableau{$nomfic}->{'Fichier_Unique'}=0 ; #print "$nomfic contient des figures\n@sous_fichiers\n"; }; #le LIGNES: est un label utilise pour les commandes next/redo/last LIGNES: while(defined($line = )){ # on passe les lignes vides : if ($line =~ m/^\s$/o) { next LIGNES;}; # on cherche \begin{exo}. si on le trouve, on verifie qu'on a toutes les infos. # puis on remet toutes les variables a zero, et on verifie qu'on a le \end{exo} # et qu'il n'y a pas de \end{document}. if ($line =~ m/\\begin\{exo\}/o ) { @reste_categories=@liste_categories ; while($categ=shift(@reste_categories)){ if ($dejavu{$categ}!= 1) {die "Pas de $categ dans l'exo $nomfic\n" }; } if ($dejavu{'Titre'}!= 1) {die "Pas de titre dans l'exo $nomfic\n" }; if ($dejavu{'Annee'}!= 1) {$ajouter_annee_dans_exo=1;}; $exo_OK=1; # on cherche \end{exo}[un seul !] et \end{document}[interdit]. On en profite pour calculer la longueur de l'exo. my $nb_end_exo=0; my $longueur=0; if ($line=~ m/\\end\{document\}/o){die "L'exo $nomfic contient \\end{document}\nIl ne doit pas contenir cette commande.\n";}; if ($line=~ m/\\end\{exo\}/o){$nb_end_exo=1;}; while(defined($line = )){ if ($line=~ m/\\end\{document\}/o){die "L'exo $nomfic contient \\end{document}\nIl ne doit pas contenir cette commande.\n";}; if ($line=~ m/\\end\{exo\}/o){$nb_end_exo=$nb_end_exo+1;}; my @mots=split(/\s+/ , $line); if ($nb_end_exo==0){$longueur += scalar(@mots);}; # on compte le nombre de mots pour savoir la taille. #scalar(@liste) renvoie le nombre d'elements de la liste }; if ($nb_end_exo>1){die "Plusieurs commandes \\end{exo} dans $nomfic\nSTOP\n";}; if ($nb_end_exo==0){die "Pas de commande \\end{exo} dans $nomfic\nSTOP\n";}; $tableau{$nomfic}->{'Longueur'}=$longueur ; # en fait inutile puisque on ne fait pas de recueil par longueur. push @{$cles_sec{'Longueur'}},$longueur; push @{$tableau_officiels{'Longueur'}},1;# les longueurs sont toutes officielles push @{$categ_sec{'Longueur'}},$longueur; push @{$nom_sec{'Longueur'}},$nomfic ; last LIGNES ; } ; # on boucle sur les categories principales pour rechercher '\Theme{...}', ... @reste_categories=@liste_categories ; while($categ=shift(@reste_categories)){ if ($line =~ m/(\\$categ\{)(.*)$/ ) { ($resultat,$reste_ligne)= match_accollades("$2\n"); #on rajoute \n car il n'est pas contenu dans $2. if ( $dejavu{$categ}==1 ) { die("L'exo $nomfic contient deux fois la commande $categ\n") } ; $dejavu{$categ}=1 ; $tableau{$nomfic}->{$categ}=$resultat ; # on verifie que $resultat ne contient pas de virgule: une virgule signifie sans doute # une separation entre diverses categories, il faut utiliser les categ secondaires pour ca. if ($resultat =~ /,/o) { die("exo $nomfic: la commande $categ contient une virgule.\nA mettre en $categ secondaire \n"); } ; # assignation des cles de tri. Traitement special pour les auteurs: on veut # trier selon le nom de famille. Utilisation de la commande ``\textsc{'' comme marqueur # du debut du nom de famille. # Frederic \textsc{Le Roux} -> cle="Le Roux}" # Frededric Le \textsc{Roux} -> cle="Roux}". if ($categ ne "Auteur") {# les auteurs sont tries selon le nom de famille = 2eme mot if (defined $cle_tri{$resultat}) {$cle=$cle_tri{$resultat}} else {$cle=$resultat}; } else {# Si le nom de l'auteur contient ``\textsc{'', on prend ce qu'il y a apres. # sinon, on prend ce qu'il y a apres le premier espace. if ( $resultat =~ m/\\textsc\s*\{\s*(.+)$/o ) { $cle=$1;} elsif ($resultat =~ m/\S+\s+(.+)$/o ) {$cle=$1;} else {$cle = $resultat ;}; } if (($categ ne "Date") and ($categ ne "Auteur")) { if ($resultat !~ m/^\\.*$/o ) { print STDERR "$nomfic.tex:\n Attention, utilisation d'une categorie non officielle ($resultat) comme categorie principale. Je la considere pour le tri comme officielle.\n" }; } if ($categ eq 'Date') { #on verifie le format YYYY/MM/JJ . if ( $resultat =~ m/^(\d\d\d\d)\/(\d\d)\/(\d\d)$/o ) { $annee=$1; $mois=$2; $jour=$3; if (($jour>31) or ($mois >12) or ($annee <1999)){ die "Date bizarre dans $nomfic.tex. Format: AAAA/MM/JJ\n Date lue: annee= $annee mois= $mois jour= $jour " }; } else { die "Date non conforme au format AAAA/MM/JJ dans $nomfic.tex\n" } ; } $cle=desaccentuation($cle); $tableau_cles{$nomfic}->{$categ}=$cle ; push @{$cles_sec{$categ}},$cle ; push @{$tableau_officiels{$categ}},1 ; # on force les categs principales a etre officielles push @{$categ_sec{$categ}},$resultat ; push @{$nom_sec{$categ}},$nomfic ; $line=$reste_ligne; redo LIGNES; } ; } # fin de la partie recherche des categ principales # on boucle sur les categories secondaires @reste_categories=@liste_categories ; CATEGS: while($categ=shift(@reste_categories)){ if (not defined $liste_categ_sec{$categ}) {next CATEGS}; #next du while sur les categs #on ne regarde pas les categs #sans categ secondaire associee $categ_sec=$liste_categ_sec{$categ}; if ($line =~ m/(\\$categ_sec\{)(.*)$/ ) { ($resultats_bruts,$reste_ligne)= match_accollades("$2\n"); #on rajoute \n car il n'est pas contenu dans $2. @resultats= split(/[\s]*,[\s]*/,$resultats_bruts) ; #convertit les mots de la chaine $resultats_bruts separes par des #virgules en la liste @resultats. if ( $dejavu{$categ_sec}==1 ) { die("L'exo $nomfic contient deux fois la commande $categ_sec\n") } ; $dejavu{$categ_sec}=1 ; RESULTATS: foreach $resultat (@resultats){ if ( $resultat =~ m/^[\s]*$/o ) {next RESULTATS} ; # on saute les champs blancs # ce qui peut arriver si on recoit \CategSecondaire{} if ( $resultat eq $tableau{$nomfic}->{$categ} ) {print STDERR "Attention dans $nomfic.tex, $categ et $categ_sec ont un element commun\n"; next RESULTATS }; #si la categ secondaire qu'on a apparait deja en categ principale, #on la saute et on ecrit un message. # assignation des cles de tri. Traitement special pour les auteurs: on veut # trier selon le nom de famille. Utilisation de la commande ``\textsc'' comme marqueur # du debut du nom de famille. if ($categ ne "Auteur") {# les auteurs sont tries selon le nom de famille = 2eme mot if (defined $cle_tri{$resultat}) {$cle=$cle_tri{$resultat}} else {$cle=$resultat}; } else {# Si le nom de l'auteur contient ``\textsc{'', on prend ce qu'il y a apres. # sinon, on prend ce qu'il y a apres le premier espace. if ( $resultat =~ m/\\textsc\s*\{\s*(.+)$/o ) { $cle=$1;} elsif ($resultat =~ m/\S+\s+(.+)$/o ) {$cle=$1;} else {$cle = $resultat}; }; #voir si officiel ou pas if (($resultat =~ m/^\\.*$/o ) or ($categ eq "Auteur")) { $officiel=1 } else { $officiel=0 }; push @{$cles_sec{$categ}},$cle ; push @{$tableau_officiels{$categ}},$officiel; push @{$categ_sec{$categ}},$resultat ; push @{$nom_sec{$categ}},$nomfic ; } #fin du foreach RESULTATS $line=$reste_ligne; redo LIGNES } ; } #fin de la recherche des categs secondaires #ensuite on cherche l'annee if ($line =~ m/(\\Annee\{)(.*?)\}/ ) { $resultat=$2; if ( $dejavu{'Annee'}==1 ) { die("L'exo $nomfic contient deux fois la commande Annee\n") } ; if ($resultat !~ m/^\d\d\d\d$/){ die("L'exo $nomfic a une Annee non faite de 4 chiffres\n")} ; $dejavu{'Annee'}=1 ; $tableau{$nomfic}->{'Annee'}=$resultat ; #inutilise... } # sinon on cherche le titre if ($line =~ m/(\\Titre\{)(.*)$/o ) # si la ligne contient ``\Titre{'' { if ( $dejavu{'Titre'}==1 ) {die "Deux titres dans l'exo $nomfic\n" }; $dejavu{'Titre'}=1 ; ($titre,$reste_ligne)= match_accollades("$2\n"); #on rajoute \n car il n'est pas contenu dans $2. $tableau{$nomfic}->{'Titre'}=$titre ; $line=$reste_ligne; redo LIGNES ; #(on repart sur la boucle LIGNES avec $line=$reste_ligne) } ; # sinon on cherche le \titrebookmark if ($line =~ m/(\\titrebookmark\{)(.*)$/o ) # si la ligne contient ``\titrebookmark{'' { if ( $dejavu{'titrebookmark'}==1 ) {die "Deux \\titrebookmark dans l'exo $nomfic\n" }; $dejavu{'titrebookmark'}=1 ; ($titrebookmark,$reste_ligne)= match_accollades("$2\n"); #on rajoute \n car il n'est pas contenu dans $2. $tableau{$nomfic}->{'titrebookmark'}=$titrebookmark ; $line=$reste_ligne; redo LIGNES; } ; } #fin du while sur les lignes # quand on est la c'est qu'on a termine de lire FICHIER_TEX # soit parce qu'on a vu begin{exo} et end{exo} ( -> last LIGNES), # soit parce que le fichier est termine. # il faut lire FICHIER_TEX en entier avant de le fermer sinon, il y a une erreur a cause du pipe. my $aux= $/; undef $/; # ceci fait en sorte que readline lit tout le fichier d'un coup au lieu de lire 1 seule ligne. my $contenu=readline(*FICHIER_TEX); close FICHIER_TEX or die ("erreur fermeture1 $nomfic\n"); $/=$aux; if ( $exo_OK != 1){die("Exercice $nomfic incomplet\n");}; # si necessaire, on ajoute la commande \Annee dans le fichier tex (utile pour les exos indiv, pour le copyright) if ($ajouter_annee_dans_exo == 1){ rename "$nomfic.tex", "$nomfic.annee" or die("Erreur renomination $nomfic.annee\n"); open NOUVEAU, ">$nomfic.tex" or die("erreur ouverture $nomfic.tex en ecriture (ajout annee)\n"); open ANCIEN, "<$nomfic.annee" or die("erreur ouverture $nomfic.annee \n"); print NOUVEAU "\\Annee\{$annee\}\n"; my $aux= $/; undef $/; # ceci fait en sorte que readline lit tout le fichier d'un coup au lieu de lire 1 seule ligne. my $contenu=readline(*ANCIEN); close ANCIEN or die ("erreur fermeture2 $nomfic.annee\n"); print NOUVEAU $contenu; close NOUVEAU or die ("erreur fermeture3 $nomfic.tex\n"); unlink ("$nomfic.annee"); $/=$aux; }#fin de l'ajout de l'annee dans nomfic }#fin du while sur les fichiers }#fin du while sur les repertoires ############################################################################### ######## partie 2: tri et ecriture des fichiers tex. ##################################################################### my ($exo_nouveau,$date_exo,$html_nouveau); my ($nom_fichier_en_cours,$nom_fichier_nouveaux_en_cours); my @nom_mois=('Janvier','Février','Mars','Avril','Mai','Juin','Juillet','Août','Septembre','Octobre','Novembre','Décembre'); chdir "$sources/compilation"; # dans toute la suite on reste dans le repertoire compilation # on trie ces tableaux selon les categories principales (pour lesquelles on veut faire un recueil): # `sort' donne la liste des exos (noms de fichiers) selon l'ordre voulu @reste_categories=(@liste_categories,@liste_categories_calculees); BOUCLE_CATEG : while($categ=shift(@reste_categories)){ if (defined($liste_categories_sans_receuil{$categ})) {next BOUCLE_CATEG;}; #on saute les categories sans receuil if ($categ eq 'Date') {$sens=-1} else {$sens=1}; $trie_par{$categ}= [ sort compare_principal ( keys %tableau_cles ) ] ; # les noms des exos a trier= keys %tableau_cles # les crochets sont pour creer un pointeur (voir `man perlreftut') # ici on cree les fichiers tex foreach $format ( 'a4', 'navig') { $nom_fichier_en_cours="${nom_fichier_tex}${categ}_$format.tex"; open SORTIE_NORMALE,">${nom_fichier_en_cours}" or die("erreur ecriture ${nom_fichier_en_cours}\n"); if ( $categ eq 'Date') # pour la categ date, on fait 2 fichiers, un pour tous, un pour les nouveaux { $nom_fichier_nouveaux_en_cours="${nom_fichier_tex_nouveau}${categ}_$format.tex"; open SORTIE_NOUVEAUX,">${nom_fichier_nouveaux_en_cours}" or die("erreur ecriture ${nom_fichier_nouveaux_en_cours}\n"); } foreach $fichier ( "entete1_$format.tex", "entete2_$categ.tex", "entete3_commune.tex", "entete4_exos_tries.tex" ) {open ENTREE,"<$fichier" or die("fichier $fichier introuvable\n"); undef $/; # ceci fait en sorte que readline lit tout le fichier d'un coup au lieu de lire 1 seule ligne. $contenu=readline(*ENTREE); close ENTREE or die ("erreur fermeture $fichier\n"); print SORTIE_NORMALE $contenu; if ( $categ eq 'Date') { print SORTIE_NOUVEAUX $contenu ;} } if (($categ eq 'Date') and ($format eq 'a4')) {$faire_liste_mail=1 ; open LISTE_MAIL,">$sources/liste_mail.txt" or die("Erreur ouverture $sources/liste_mail.txt");} else {$faire_liste_mail=0 ;}; my $ancien_exo='zZzzZ'; my $premiere_boucle=1; foreach $exo ( @{$trie_par{$categ}} ) { my $date_exo=$tableau{$exo}->{'Date'}; if ( $date_exo ge $date_nouveau ) {$exo_nouveau=1} else {$exo_nouveau=0}; $contenu_categ=$tableau{$exo}->{$categ}; #doit etre hors de la boucle sur les fichiers sortie if ($premiere_boucle!=1) { $a=$exo; $b=$ancien_exo; $comp=compare_principal ; if ($comp <0){die "erreur tri principal \n";} } else {$comp=2}; # au premier coup, on met toujours une separation if ($categ eq 'Date'){ # dans le cas de Date, on utilise le mois plutot que qqchose comme 2002/02/01 ($an,$mois,$jour)=split(/\//,$contenu_categ); $jour=$jour; #pour eviter un warning car $jour est inutilise $contenu_categ="${nom_mois[$mois-1]} $an"; print SORTIE_NORMALE "\\DateAEcrire\{$contenu_categ\}\n"; if ($exo_nouveau==1) {print SORTIE_NOUVEAUX "\\DateAEcrire\{$contenu_categ\}\n";} } # ecriture de l'exo dans le fichier mail a envoyer (LISTE_MAIL) if (($faire_liste_mail==1) and ($date_exo ge $date_mail)) {print LISTE_MAIL $tableau{$exo}->{'Titre'}."\n ".$tableau{$exo}->{'Niveau'}.". ".$tableau{$exo}->{'Theme'}.". ".$tableau{$exo}->{'AnglePedagogique'}."\n";} #j'ai enleve "${http}/${exo}.pdf\n" qui rajoutait l'adresse de chaque exo # si on cree le fichier par date et que l'exo est nouveau, # @liste_sorties va contenir les 2 fichiers (SORTIE_NORMALE et SORTIE_NOUVEAUX) if (($categ eq 'Date') and ($exo_nouveau==1)) { @liste_sorties=(SORTIE_NORMALE,SORTIE_NOUVEAUX)} else { @liste_sorties=(SORTIE_NORMALE)}; foreach $SORTIE ( @liste_sorties ) { # on boucle sur les fichiers sortie (SORTIE_NORMALE / SORTIE_NOUVEAUX) if ($comp==2) {print $SORTIE "\n\\separation\n\n"; }; print $SORTIE "\n%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"; print $SORTIE "\n\\nomfic\{$exo\}\n"; my $nomficimprimable=$exo; $nomficimprimable =~ s/_/\\_/og ; # on remplace '_' par '\_' print $SORTIE "\\nomficimprimable\{$nomficimprimable\}\n"; # Si fichier unique, on insere la commande \FichierUnique if ( $tableau{$exo}->{'Fichier_Unique'} ==1 ) { print $SORTIE "\\FichierUnique"; } ; if ( defined $tableau{$exo}->{'titrebookmark'} ) { $titre_bookmark=$tableau{$exo}->{'titrebookmark'} } else { $titre_bookmark=$tableau{$exo}->{'Titre'}; $titre_bookmark =~ s/\?/\\pointinterrogation /og ; # on remplace les points d'interrogation $titre_bookmark =~ s/\!/\\pointexclamation /og ; # on remplace les points d'exclamation $titre_bookmark =~ s/:/\\deuxpoints /go ; # deuxpoints $titre_bookmark =~ s/\;/\\pointvirgule /go ; # pointvirgule }; print $SORTIE "\\titrebookmark\{$titre_bookmark\}\n"; if ($exo_nouveau==1) { print $SORTIE "\\nouveau\n" } ; $repertoire=$tableau{$exo}->{'repertoire'}; open ENTREE,"<$sources/${repertoire}/${exo}/${exo}.tex" or die("fichier $sources/${repertoire}/${exo}/${exo}.tex introuvable\n"); $contenu=readline(*ENTREE); close(ENTREE) or die ("erreur fermeture $exo\n"); print $SORTIE $contenu; print $SORTIE "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"; };# fin de la boucle sur les fichiers SORTIE $ancien_exo=$exo; $premiere_boucle=0; } ;# fin de la boucle sur les exos open ENTREE,"${nom_fichier_index}${categ}${NOUVEAU}.tex" or die("erreur ecriture ${nom_fichier_index}${categ}${NOUVEAU}.tex\n"); open SORTIE_HTML,">html_${nom_fichier_index}${categ}${NOUVEAU}.tex" or die("erreur ecriture html_${nom_fichier_index}${categ}${NOUVEAU}.tex\n"); $index_par{$categ}= [ sort compare_index ( 0 .. $#{$cles_sec{$categ}} ) # compare= nom de procedure de comparaison # puis les indices a trier (de 0 a la taille du tableau) ] ;# les crochets sont pour creer un pointeur (voir `man perlreftut') my $ancien_indice=-1; my $premiere_boucle=1; my $comp=4; my $cmd_officiel; BOUCLE_INDICE: foreach $indice ( @{$index_par{$categ}} ) { $exo=$nom_sec{$categ}->[$indice]; my $date_exo=$tableau{$exo}->{'Date'}; if ( $date_exo ge $date_nouveau ) {$exo_nouveau='Nouveau'; $html_nouveau='{\textcolor{red}{*}}'} else {$exo_nouveau=''; $html_nouveau=''}; if (($NOUVEAU ne '') and ($exo_nouveau eq '')){next BOUCLE_INDICE}; #on saute les exos non-nouveaux dans les indexs_Nouveaux $contenu_categ=$categ_sec{$categ}->[$indice]; $officiel=$tableau_officiels{$categ}->[$indice]; # si c'est le tri par date, tout est officiel if ( $categ eq 'Date' ) {$officiel=1}; if ($officiel==1) {$cmd_officiel=''} else {$cmd_officiel='NonOfficiel'}; if ( $premiere_boucle != 1) { $a=$indice; $b=$ancien_indice; $comp=compare_index ; }; if ($comp <0) {die "erreur de tri d'index, anormalite trouvee \n"}; if ( (($premiere_boucle==1) or ($comp==4)) and ($officiel==0) ) { # si on rentre dans du non-officiel print SORTIE "\n\\NonOfficiel$categ\n"; print SORTIE_HTML "\n\\NonOfficiel$categ\n"; }; if (($comp >= 2)) { #si on doit mettre une separation, if ($categ eq 'Date') { ($an,$mois,$jour)=split(/\//,$contenu_categ); $jour=$jour; #pour eviter un warning car $jour est inutilise my $date_a_ecrire="${nom_mois[$mois-1]} $an"; print SORTIE "\n${commande_separation_index}$categ${cmd_officiel}\{".$date_a_ecrire."\}\n" ; print SORTIE_HTML "\n${commande_separation_index}$categ${cmd_officiel}\{".$date_a_ecrire."\}\n" ; } elsif ($categ eq 'Longueur') { my $seuil1=seuil($contenu_categ); my $seuil2=seuil($seuil1*3); print SORTIE "\n${commande_separation_index}$categ${cmd_officiel}\{"."Entre $seuil1 et $seuil2 mots."."\}\n" ; print SORTIE_HTML "\n${commande_separation_index}$categ${cmd_officiel}\{"."Entre $seuil1 et $seuil2 mots."."\}\n" ; } else { print SORTIE "\n${commande_separation_index}$categ${cmd_officiel}\{".$contenu_categ."\}\n" ; print SORTIE_HTML "\n${commande_separation_index}$categ${cmd_officiel}\{".$contenu_categ."\}\n" ; }; };# fin du if comp>=2 $titre=$tableau{$exo}->{'Titre'}; my $nomficimprimable=$exo; $nomficimprimable =~ s/_/\\_/og ; # on remplace '_' par '\_' $commande="${commande_index}$categ${cmd_officiel}${exo_nouveau}\{$titre\}"; $commande=$commande."\{".$prefixe_label.$exo."\}"; my @reste_categories2=(@liste_categories,@liste_categories_calculees) ; INFOS: while(my $categ2=shift(@reste_categories2)){ if (defined($liste_categories_non_precisees_a_chq_entree_d_index{$categ2})){next INFOS}; $commande=$commande.'{'.$tableau{$exo}->{$categ2}.'}'; } #fin du petit while INFOS print SORTIE "$commande\n"; my $titre_html=$titre; # le if qui suit servait a mettre en verbatim un titre qui contiendrait le caractere ``$'' # parce que ma version de latex2html ne marchait pas assez bien avec les maths. # C'est maintenant obsolete #if ( $titre =~ m/\$/o ) { # si $titre contient ``$'', on mets ca en verbatim dans le html # # on cherche un caractere inutilise pour faire verb # my $char='' ; # foreach $c ('|','@','~','*','!','?','&') { # $regexp="\\".$c ; # if ( $titre !~ m/$regexp/ ) { $char=$c; last } ; #on quitte la boucle # } ; # if ($char eq '') {die("Pas pu trouver un caractere pour faire \\verb\n");} ; # $titre_html="\\verb".$char.$titre.$char ; # } # else { $titre_html=$titre } ; my $commande_html; $commande_html='\noindent '.$titre_html.$html_nouveau."~: "; my $lien_sources ; # contient le lien vers le fichier tex ou le repertoire le contenant selon unicite if ($tableau{$exo}->{'Fichier_Unique'}==1) { $lien_sources='\htmladdnormallink{tex}{'.$repertindiv.'/tex/'.$nomficimprimable.'/'.$nomficimprimable.".tex},\n";} else { $lien_sources='\htmladdnormallink{tex+figures}{'.$repertindiv.'/tex/'.$nomficimprimable."/},\n";}; $commande_html=$commande_html. '\htmladdnormallink{pdf}{'.$repertindiv.'/pdf\_navigable/'.$nomficimprimable.".pdf},\n". '\htmladdnormallink{pdf imprimable}{'.$repertindiv.'/pdf\_imprimable/'.$nomficimprimable.".pdf},\n". '\htmladdnormallink{postscript}{'.$repertindiv.'/postscript/'.$nomficimprimable.".ps.gz},\n". $lien_sources. '\htmladdnormallink{dvi}{'.$repertindiv.'/dvi/'.$nomficimprimable.".dvi}.\\newline\n". '\textit{\small '; foreach $categ2 ('Theme','Niveau','AnglePedagogique','Longueur') { if ($categ2 ne 'Longueur') {$commande_html=$commande_html.$categ2.": ".$tableau{$exo}->{$categ2}.". " ;} else {$commande_html=$commande_html.$tableau{$exo}->{$categ2}." mots. " ;} } $commande_html=$commande_html.'}\\\\'."\n\n"; print SORTIE_HTML "$commande_html"; $premiere_boucle=0; $ancien_indice=$indice; } close(SORTIE); close(SORTIE_HTML); } } # c'est fini