#!/usr/bin/perl
#fabrique un extrait à partir d'une page web pour l'insérer dans la partie droite des nouvelles pages
use strict;
#print @ARGV; #si on veut appliquer à un fichier le pgm: perl pgm fic
#Date
#Change suivant les locale de la machine

my $datefr=`date`;
$datefr=~s/\(.*$//g;
$datefr=~s/,//g;
my @date=split(/ +/,$datefr);
my @heure=split(/:+/,$date[4]);
#chomp $date[5];
my $datesauve= ".svgdu".$date[1].$date[2].$date[3]."a".$heure[0]."h";
print  $datesauve;
#Fin date

#Préalables: fichier source
my $f="debatspourweb.html";   #coronavirus/Preliminaires.html"; #chemin/file.html ou file.html
my $dossier; my $fcourt; my $extension;
($dossier, $fcourt, $extension)=($f=~/(^.*\/)(.*).(html)/);
if ($dossier eq "")
	{
	($fcourt, $extension)=($f=~/(.*).(html)/);
	}
else
	{
	chdir ($dossier) ;
	}
	
my $fresu=$fcourt.".tag";
my $factuel=$fcourt.".html";
my $fsave=$factuel.$datesauve;

#print join("\n",$f, $factuel, $fresu,$fsave),"\n\n";
system ("/bin/cp $factuel $fsave");	#sauvegarde

open (F,$factuel);
open (G,">$fresu");
#Fin préalables: fichier source

#Repérage du body (vieux fichiers html)
my $regexp="<[\/]?[bB][oO][dD][yY][^>]*>";
my $tout;
#Sinon repérage des infos importantes:
#$regexp="<[\/]?importationessentielle[^>]*>";
while(<F>)
	{
	#petit nettoyage pour fichiers html (remplacer par une macro?)
	s/<[Pp] *>/<p\/>/g;
 	s/<[Bb][Rr] *>/<br\/>/g;
	$tout.=$_;
	}
close (F);
my @morceaux=split (/$regexp/,$tout);
my $corpsdutexte=$morceaux[1];
#En théorie, le fichier $f est coupé en
#$morceaux[0] (avant <body>) ou <importationessentielle>
#$morceaux[1] (ce qui nous intéresse)
#$morceaux[2] (après </body>) ou </importationessentielle>
 
#mots-clés du fichier
(my $motscleslocaux)=($morceaux[0]=~/< *[mM][eE][tT][aA] +[nN][aA][mM][eE] *= *\"* *[Kk][Ee][Yy][Ww][Oo][Rr][Dd] *\"* +[cC][oO][nN][tT][eE][nN][tT] *= *\"* *([^>]+)>/);
$motscleslocaux=~s/\n/ /g;
$motscleslocaux=~s/[ \/\"]*$//g; #vire les / " et espaces de la fin
$motscleslocaux="vide" if $motscleslocaux =~/^ *$/;

#Récupérer le titre
(my $titre)= ($morceaux[0]=~/<title> *([^<]+) *<\/title>/);
$titre=~s/\n/ /g;
$titre="sans-titre" if $titre =~/^ *$/;

#Encodage
(my $encodage)= ($morceaux[0]=~/[cC][Oo][Nn][Tt][Ee][Nn][Tt]-[tT][Yy][Pp][Ee]\"*([^>]+)>/); 
#un peu lourd, mais évite d'autres charsets (js, etc.)
#et précaution pour prévenir erreurs de syntaxe
$encodage=~s/\n/ /g;
$encodage=~s/^.*[Cc][Hh][Aa][Rr][Ss][Ee][Tt] *= *//g;
$encodage=~s/[ \/\"]*$//g;
$encodage="vide" if $encodage =~/^ *$/;

#Dates inscrites
my $datecreationfic; my $datemodificationfic;
($datecreationfic)=($corpsdutexte=~/<datecreationfic>([^<]*)<\/datecreationfic>/);
($datemodificationfic)=($corpsdutexte=~/<datemodificationfic>([^<]*)<\/datemodificationfic>/);

#Premiers paramètres à écrire			
print G "<parametresdentree>\n";
print G "<encodage>$encodage<\/encodage>\n";
print G "<motscleslocaux>$motscleslocaux<\/motscleslocaux>\n";
print G "<memotitre>$titre<\/memotitre>\n";
print G "<datecreationfic>$datecreationfic</datecreationfic>\n"; #si vide, remplir à la main
print G "<datemodificationfic>$datemodificationfic</datemodificationfic>\n"; #modifier à la main
#print G "<enviemotsclesgeneraux>0<\/enviemotsclesgeneraux>\n"; #pour insert keywords.html; 0= non; 1= oui
#inutile: on insère les mots-clés en couleur là où on repère un <importkeywordscouleur/>
#En pratique, <importkeywordscouleur/> sera quelque part dans la partie essentielle
#Pour rectification ultime de fichiers déjà propres
print G "<\/parametresdentree>\n";
if ($corpsdutexte=~/<importationessentielle>/ && $corpsdutexte=~/<\/importationessentielle>/)
	{
	my $regexp2="<[\/]?importationessentielle[^>]*>";
	my @petitsmorceaux=split (/$regexp2/,$corpsdutexte);
	print G "\n	<importationessentielle>
	$petitsmorceaux[1]
	<\/importationessentielle> \n";
	}
else
	{
	print G "\n	<importationessentielle>
	$morceaux[1]
	<\/importationessentielle> \n";
	}
close (G);
