#!/usr/bin/perl


# Déclaration des pragmas
use strict;
use utf8;
use open qw/:std :utf8/;

# Appel des modules externes de base
use Encode qw(decode_utf8 encode_utf8 is_utf8);
use Getopt::Long;

# Appel des modules spécifiques à l'application
use URI::Encode qw(uri_encode uri_decode);
use LWP::Simple;
use JSON;
# use Text::Unidecode;

my ($programme) = $0 =~ m|^(?:.*/)?(.+)|;
my $usage = "Usage : \n    $programme ( -r 'requête' | -c fichier_corpus ) ( -t (all|pdf|tei|txt|zip)[,(pdf|tei|txt|zip)]* | \n" .
            " " x (5 + length($programme)) . "-e (all|multicat|refBibs|...)[,(multicat|refBibs|...)]* | -m (all|mods|xml) )\n" .
            " " x (5 + length($programme)) . "[ -d destination ] [ -n notices ] [ -p préfixe ] [ -s fichier_corpus ] [ -iv ]\n" .
            "    $programme ( -r 'requête' | -c fichier_corpus ) -a [ -d destination ] [ -n notices ] [ -p préfixe ] \n" . 
            " " x (5 + length($programme)) . "[ -s fichier_corpus ] [ -iv ]\n" .
            "    $programme -h\n\n";

my $version     = "2.0.4";
my $dateModif   = "12 Juillet 2017";

# Variables
my $aide            = 0;
my $all             = 0;
my $corpus          = "";
my $destination     = ".";
my $indexation      = 0;
my $notices         = "";
my $prefixe         = "";
my $quiet           = 0;
my $requete         = "";
my $source          = "";
my $verbeux         = 0;
my @enrichissements = ();
my @metadonnees     = ();
my @types           = ();
my %echecs          = ();

eval	{
	$SIG{__WARN__} = sub {usage(1);};
	GetOptions(
		"all"               => \$all,
		"corpus"            => \$corpus,
		"destination=s"     => \$destination,
		"help"              => \$aide,
		"enrichissements=s" => \@enrichissements,
		"indexation"        => \$indexation,
		"metadonnees=s"     => \@metadonnees,
		"notices=s"         => \$notices,
		"prefixe=s"         => \$prefixe,
		"requete=s"         => \$requete,
		"source=s"          => \$source,
		"texte=s"           => \@types,
		"verbeux"           => \$verbeux,
		);
	};
$SIG{__WARN__} = sub {warn $_[0];};

if ( $aide ) {
	print "\nProgramme : \n    \"$programme\", version $version ($dateModif)\n";
	print "    Permet de décharger un corpus de fichiers textes (PDF, TEI, TXT), de fichiers de \n";
	print "    métadonnées (Mods, XML) ou de fichiers d’enrichissement depuis la base ISTEX à partir \n";
	print "    d’une requête ou d’un fichier corpus. Également, renomme les fichiers déchargés et \n";
	print "    génère un fichier de notices bibliographiques.\n";
	print "    N.B. : AUCUNE MÉTHODE D’AUTHENTIFICATION SUPPORTÉE POUR L’INSTANT.\n\n";
	print $usage;
	print "Options :\n";
	print "   -a  télécharge tous les fichiers correspondants aux documents\n";
	print "   -c  utilise le fichier corpus \"fichier_corpus\" (incompatible avec les options -r \n";
	print "       et -s ; en cours de réalisation)\n";
	print "   -d  indique le répertoire de destination des documents (répertoire courant par défaut)\n";
	print "   -h  affiche cette aide\n";
	print "   -e  liste les enrichissements à télécharger, soit \"all\" pour l’ensemble, soit \n";
	print "       \"abesAuthors\", \"abesSubjects\", \"multicat\", \"nb\", \"refBibs\", \"teeft\" ou \"unitex\"\n";
	print "   -i  ajoute l'indexation automatique, e.g. TEEFT, dans les notices bibliographiques\n";
	print "   -m  liste les fichiers de métadonnées à télécharger, soit \"all\" pour l’ensemble, \n";
	print "       soit \"mods\" ou \"xml\"\n";
	print "   -n  indique le nom du fichier de notices bibliographiques généré (par défaut, \n";
	print "       \"notices.txt\" dans le répertoire courant ou celui donné par l’option -d)\n";
	print "   -p  indique le préfixe utilisé pour renommer les fichiers téléchargés (par défaut, \"f\")\n";
	print "   -r  indique la requête à utiliser, entre simples quotes en présence de blancs ou de \n";
	print "       caractères spéciaux (incompatible avec l’option -c)\n";
	print "   -s  génère un fichier corpus (incompatible avec l’option -c ; en cours de réalisation)\n";
	print "   -t  liste les fichiers de texte intégral à télécharger, soit \"all\" pour l’ensemble, \n";
	print "       soit \"pdf\", \"tei\", \"txt\" ou \"zip\"\n";
	print "   -v  garde les métadonnées ISTEX dans un fichier \"logRequete.txt\" dans le répertoire \n";
	print "       courant ou celui donné par l’option -d\n\n";
	print "Exemple : \n";
	print "   $programme -r '(host.title:\"Biofutur\" OR host.issn:\"0294-3506\")' -t pdf,tei -d FichiersPDF\n\n";
	exit 0;
	}

usage(2) if not $requete and not $corpus;
$requete = decode_utf8($requete);

# Vérification des options choisies
usage(3) if not $all and not @enrichissements and not @metadonnees and not @types;
if ( $all ) {
	@enrichissements = ('all');
	@metadonnees     = ('all');
	@types           = ('all');
	}
else	{
	@enrichissements = map {lc($_)} split(/,/, join(",", @enrichissements));
	usage(4) if grep(!/^(all|abesAuthors|abesSubjects|multicat|nb|refBibs|teeft|unitex)\z/i, @enrichissements);
	@metadonnees = map {lc($_)} split(/,/, join(",", @metadonnees));
	usage(4) if grep(!/^(all|mods|xml)\z/i, @metadonnees);
	@types = map {lc($_)} split(/,/, join(",", @types));
	usage(4) if grep(!/^(all|pdf|tei|txt|zip)\z/i, @types);
	}

usage(5) if $corpus and ($requete or $source);

if ( $prefixe ) {
	if ( $prefixe !~ /^[A-Za-z]\w+\z/ ) {
		$prefixe = "f";
		print STDERR "Erreur: préfixe non-conforme => utilisation de la valeur par défaut.\n";
		}
	}
else	{
	$prefixe = "f";
	}

if ( not $notices ) {
	if ( $prefixe ) {
		$notices = "$prefixe.txt";
		$notices =~ s/_\.txt\z/.txt/;
		}
	else	{
		$notices = "$destination/notices.txt";
		}
	}
open(OUT, ">:utf8", $notices) or die "$!,";

if ( $verbeux ) {
	open(LOG, ">:raw", "$destination/logRequete.txt") or die "$!,";
	}
else	{
	open(LOG, "> /dev/null") or die "$!,";
	}

my @time = localtime();
my $jour = (qw(Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi))[$time[6]];
my $mois = (qw(Janvier Février Mars Avril Mai juin Juillet Août Septembre Octobre Novembre Décembre))[$time[4]];
my $annee = $time[5] + 1900;
my $date = "$jour $time[3] $mois $annee ";
$date .= sprintf("%02d:%02d:%02D", $time[2], $time[1], $time[0]);

if ( $source ) {
	open(SRC, ">:utf8", $source) or die "$!,";
	print SRC "#\n# Fichier .corpus\n#\n";
	print SRC "title        : \n";
	print SRC "author       : ";
	if ( $ENV{'USER'} ) {
		print SRC uc($ENV{'USER'});
		}
	print SRC "\npublisher    : \n";
	print SRC "query        : ", decoupe2($requete);
	print SRC "date         : $date\n";
	print SRC "license      : CC-By\n";
	print SRC "versionInfo  : 1.0\n\n";
	print SRC "[ISTEX]\n";
	}


# Paramètres de l'API ISTEX
my $base = "https://api.istex.fr";
my $url  = "$base/document/?q=";
my $out  = "output=*";
my $size = 100;

my $uri = "$url" . propre($requete) . "&$out&size=$size&scroll=167s&sid=scodex-harvest-corpus";

# Variables concernant les documents
my $num     = 0;
my $format  = "";
my $suivant = "";
my $total   = 0;

# Liste des langues (codes ISO 639)
my %langue = initialise();

# Première itération
my $json = get("$uri");
my $perl = undef;
if ( defined $json ) {
	print LOG "$json\n";
	print OUT "#\n# Requête : \"$uri\"\n#\n";
	$perl = decode_json $json;
	my %top = %{$perl};
	$total = $top{'total'};
	if ( $total > 0 ) {
		print OUT "# Nombre de réponses : $total\n#\n\n";
		$format = sprintf("%%0%dd", length($total) + 1);
		if ( $top{'nextScrollURI'} ) {
			$suivant = $top{'nextScrollURI'};
			}
		else	{
			$suivant = "";
			}
		my @hits = @{$top{'hits'}};
		foreach my $hit (@hits) {
			traite($hit);
			}
		}
	else	{
		print OUT "# Nombre de réponses : 0\n#\n";
		print STDERR "Aucun document pour la requête \"$requete\"\n";
		exit 4;
		}
	}
else	{
	print STDERR "Aucune réponse du serveur \"$base\"\n";
	exit 5;
	}

# Itérations suivantes
while ( $suivant ) {
	$json = get("$suivant&sid=scodex-harvest-corpus");
	$perl = undef;
	if ( defined $json ) {
		print LOG "$json\n";
		$perl = decode_json $json;
		my %top = %{$perl};
		if ( $top{'nextScrollURI'} ) {
			$suivant = $top{'nextScrollURI'};
			}
		else	{
			$suivant =  "";
			}
		my @hits = @{$top{'hits'}};
		foreach my $hit (@hits) {
			traite($hit);
			}
		}
	else	{
		print STDERR "Aucune réponse du serveur \"$base\"\n";
		exit 5;
		}
	}

# Tentative de récupération des rejets
if ( %echecs ) {
	$quiet ++;
	my $old = keys %echecs;
	my $nb = 2;
	while ( $nb ) {
		$nb --;
		foreach my $item (map  {$_->[0]}
				sort {$a->[1] <=> $b->[1]}
				map  {[$_, /(\d+)\t/]} keys %echecs) {
			delete $echecs{$item};
			dl(split(/\t/, $item));
			}
		my $new = keys %echecs;
		if ( $new < $old ) {
			$old = $new;
			$nb ++;
			}
		else	{
			sleep 10;
			}
		}
	}

if ( %echecs ) {
	print STDERR "Échec pour : \n";
	foreach my $item (map  {$_->[0]}
			  sort {$a->[1] <=> $b->[1]}
			  map  {[$_, /(\d+)\t/]} keys %echecs) {
		print STDERR "$item\n";
		}
	}

close SRC if $source;
close OUT;
close LOG;


exit 0;


sub usage
{
my $code = shift;

print STDERR $usage;

exit $code;
}

sub traite
{
my $hit = shift;

$num ++;
my %hit = %{$hit};
my $succes = 0;
my $extension = "";

if ( $source ) {
	my $racine = $prefixe . sprintf($format, $num);
	print SRC "id  $hit{'id'}    # $racine\n";
	}
my @fulltext = @{$hit{'fulltext'}};
foreach my $fulltext (@fulltext) {
	my %fulltext = %{$fulltext};
	if ( grep(/^all\z/, @types) ) {
		dl($num, $hit{'id'}, $fulltext{'uri'}, $fulltext{'extension'}, $fulltext{'mimetype'});
		$succes ++;
		next;
		}
	foreach my $type (@types) {
		if ( $fulltext{'mimetype'} =~ /\b$type\b/ or
		     $fulltext{'extension'} =~ /\b$type\b/ ) {
			dl($num, $hit{'id'}, $fulltext{'uri'}, $fulltext{'extension'}, $fulltext{'mimetype'});
			$succes ++;
			last;
			}
		}
	}

my @metadata = @{$hit{'metadata'}};
foreach my $metadata (@metadata) {
	my %metadata = %{$metadata};
	if ( grep(/^all\z/, @metadonnees) ) {
		dl($num, $hit{'id'}, $metadata{'uri'}, $metadata{'extension'}.".xml", $metadata{'mimetype'});
		$succes ++;
		next;
		}
	foreach my $metadonnee (@metadonnees) {
		if ( $metadata{'extension'} =~ /\b$metadonnee\b/ ) {
			dl($num, $hit{'id'}, $metadata{'uri'}, $metadata{'extension'}.".xml", $metadata{'mimetype'});
			$succes ++;
			last;
			}
		}
	}

my %enrichments = %{$hit{'enrichments'}};
foreach my $enrichment (sort keys %enrichments) {
	next if $#{$enrichments{$enrichment}} < 0;
	my %enrichment = %{$enrichments{$enrichment}->[0]};
	if ( grep(/^all\z/, @enrichissements) ) {
		dl($num, $hit{'id'}, $enrichment{'uri'}, "$enrichment.$enrichment{'extension'}", $enrichment{'mimetype'});
		$succes ++;
		next;
		}
	foreach my $enrichissement (@enrichissements) {
		if ( $enrichissement =~ /^$enrichment\z/i ) {
			dl($num, $hit{'id'}, $enrichment{'uri'}, "$enrichment.$enrichment{'extension'}", $enrichment{'mimetype'});
			$succes ++;
			last;
			}
		}
	}

if ( not $succes ) {
	my $types = join("/", sort @types);
	print STDERR "Pas de lien pour le document ", uc($types) . " \"$hit{'id'}\"\n";
	}
my @notice = notice($hit, $num, $total);
if ( @notice ) {
	foreach my $ligne (@notice) {
		print OUT "$ligne\n";
		}
	print OUT "   \n";
	}
}

sub dl
{
my ($rang, $id, $lien, $ext, $mt) = @_;
my $item = join("\t", @_);

my $extension = "";
if ( $ext =~ /\w+\.\w+/o ) {
	$extension = "_$ext";
	}
else	{
	$extension = ".$ext";
	}
$mt =~ s|^application/\w+\+xml\z|application/xml|o;

my $fichier = "$prefixe" . sprintf($format, $rang) . "$extension";

my $code = getstore($lien."?sid=scodex-harvest-corpus", "$destination/$fichier");
if ( $code != 200 ) {
	print STDERR "Erreur de chargement pour le document ", uc($ext) . " \"$id\" : code $code\n" if not $quiet;
	$echecs{$item} ++;
	if ( -f "$destination/$fichier" ) {
		unlink "$destination/$fichier";
		}
	return $code;
	}

# Vérification du fichier reçu
open(FILE, "file --brief --mime-type $fichier |") or die "$!,";
chomp(my $type = <FILE>);
close FILE;

if ( $type ne $mt ) {
	if ( $type eq "text/html" ) {
		$echecs{$item} ++;
		unlink "$destination/$fichier";
		print STDERR "Authentification demandée pour le document ", uc($ext) . " \"$id\" [$fichier]\n" if not $quiet;
		return 0;
		}
	}

return $code;
}

sub initialise
{
my %hash =  ();

while (<DATA>) {
	next if /^\s*#/o;
	next if /^\s*\z/o;
	if ( /^% +(\w+)/o ) {
		my $token = $1;
		last if $token eq "FIN";
		}
	elsif ( /\t/o ) {
		chomp;
		s/\r//o;
		my ($code, $intitule) = split(/\t/);
		$hash{$code} = $intitule;
		$hash{lc($code)} = $intitule;
		}
	}

return %hash;
}

sub propre
{
my $chaine = shift;

# Vérification de jeu de caractères (doit être UTF-8)
if ( is_utf8($chaine, Encode::FB_QUIET) ) {

##	# Échappement des caractères réservés
##	$chaine =~ s#([-+&|!(){}^"~*?:\/])#\\$1#go;
##	$chaine =~ s#([][])#\\$1#go;

	# URLencodage
	$chaine = uri_encode($chaine);
	$chaine =~ s/&/%26/go;

	return $chaine;
	}
else	{
	return undef;
	}
}

sub notice
{
my ($top, $nb, $max) = @_;
my @lignes = ();
my $ligne = "";

my %top = %{$top};

# Numéro/total
push(@lignes, "$num/$total");

# Champ NO
$ligne = "NO : ISTEX $top{'id'}";
if ( $top{'corpusName'} ) {
	$ligne .= " (corpus \u$top{'corpusName'})";
	}
push(@lignes, $ligne);

# Champ TI
if ( $top{'title'} ) {
	$ligne = "TI : $top{'title'}";
	push(@lignes, $ligne);
	}

# Champ AU + AF
if ( $top{'author'} ) {
	my @authors = @{$top{'author'}};
	my @names = ();
	my @affiliations = ();
	my %affiliations = ();
	foreach my $author (@authors) {
		my %author = %{$author};
		if ( $author{'name'} ) {
			push(@names, $author{'name'});
			}
		if ( $author{'affiliations'} ) {
			foreach my $affiliation (@{$author{'affiliations'}}) {
				next if $affiliation =~ /^\s*e-mail\s?:\s/io;
				if ( not $affiliations{$affiliation} ) {
					push(@affiliations, $affiliation);
					}
				if ( $author{'name'} ) {
					push(@{$affiliations{$affiliation}}, sprintf("%d aut.", $#names + 1));
					}
				else	{
					push(@{$affiliations{$affiliation}}, "");
					}
				}
			}
		}
	if ( @names ) {
		$ligne = "AU : " . join(" ; ", @names);
		push(@lignes, $ligne);
		}
	if ( @affiliations ) {
		foreach my $affiliation (@affiliations) {
			my @tmp = grep(/./, @{$affiliations{$affiliation}});
			if ( @tmp ) {
				$affiliation .= " (" . join(", ", @tmp) . ")";
				}
			}
		$ligne = "AF : " . join(" ; ", @affiliations);
		push(@lignes, $ligne);
		}
	}

# Champ DT
my %host = ();
if ( $top{'host'} ) {
	%host = %{$top{'host'}};
	}
if ( $top{'genre'} or $host{'genre'} ) {
	$ligne = "DT : " . join(" ; ", map {"\u$_";} @{$host{'genre'}}, @{$top{'genre'}});
	push(@lignes, $ligne);
	}

# Champ SO
my @tmp = ();
push(@tmp, $host{'title'}) if $host{'title'};
# ISSN ou ISBN
if ( $host{'issn'} ) {
	push(@tmp, "ISSN ". ${$host{'issn'}}[0]);
	}
elsif ( $host{'isbn'} ) {
	push(@tmp, "ISBN ". ${$host{'isbn'}}[0]);
	}
# Choix de la date à afficher
if ( $top{'copyrightDate'} ) {
	push(@tmp, $top{'copyrightDate'});
	}
elsif ( $top{'publicationDate'} ) {
	push(@tmp, $top{'publicationDate'});
	}
elsif ( $host{'copyrightDate'} ) {
	push(@tmp, $host{'copyrightDate'});
	}
elsif ( $host{'publicationDate'} ) {
	push(@tmp, $host{'publicationDate'});
	}
if ( $host{'volume'} ) {
	push(@tmp, "vol. $host{'volume'}");
	}
if ( $host{'issue'} ) {
	push(@tmp, "n° $host{'issue'}");
	}
if ( $host{'pages'} ) {
	my %pages = %{$host{'pages'}};
	if ( $pages{'first'} ) {
		my $tmp = "p. $pages{'first'}";
		if ( $pages{'last'} ) {
			$tmp .= "-$pages{'last'}";
			}
		push(@tmp, $tmp);
		}
	elsif ( $pages{'total'} ) {
		push(@tmp, "$pages{'total'} p.");
		}
	}
if ( @tmp ) {
	$ligne = "SO : " . join(" ; ", @tmp);
	push(@lignes, $ligne);
	}

# Champ LA
if ( $top{'language'} ) {
	foreach my $langue (@{$top{'language'}}) {
		if ( $langue{$langue} ) {
			$langue = $langue{$langue};
			}
		else	{
			$langue = "\u$langue";
			}
		}
	$ligne = "LA : " . join(" ; ", @{$top{'language'}});
	push(@lignes, $ligne);
	}

# Champ AB
if ( $top{'abstract'} ) {
	$top{'abstract'} =~ s/^\s*Abstract\s?:\s+//io;
	push(@lignes, "AB : $top{'abstract'}");
	}

# Champ CC
if ( $top{'categories'} ) {
	my %categories = %{$top{'categories'}};
	if ( $categories{'wos'} ) {
		my @wos = @{$categories{'wos'}};
		if ( @wos ) {
			$ligne = "CC : " . join(" ; ", @wos);
			push(@lignes, $ligne);
			}
		}
	}

# Champs FD, ED, OD
if ( $top{'subject'} ) {
	my %kw = ();
	my @subjects = @{$top{'subject'}};
	foreach my $subject (@subjects) {
		my %keyword = %{$subject};
		if ( $keyword{'lang'} =~ /^fre\z/io ) {
			push(@{$kw{'fre'}}, $keyword{'value'});
			}
		elsif ( $keyword{'lang'} =~ /^eng\z/io ) {
			push(@{$kw{'eng'}}, $keyword{'value'});
			}
		else	{
			push(@{$kw{'mul'}}, $keyword{'value'});
			}
		}
	if ( defined $kw{'fre'} and @{$kw{'fre'}} ) {
		$ligne = "FD : " . join(" ; ", @{$kw{'fre'}});
		push(@lignes, $ligne);
		}
	if ( defined $kw{'eng'} and @{$kw{'eng'}} ) {
		$ligne = "ED : " . join(" ; ", @{$kw{'eng'}});
		push(@lignes, $ligne);
		}
	if ( defined $kw{'mul'} and @{$kw{'mul'}} ) {
		$ligne = "OD : " . join(" ; ", @{$kw{'mul'}});
		push(@lignes, $ligne);
		}
	}

# Champs FG, EG, OG
if ( $host{'subject'} ) {
	my %kw = ();
	my @subjects = @{$host{'subject'}};
	foreach my $subject (@subjects) {
		my %keyword = %{$subject};
		if ( $keyword{'lang'} =~ /^fre\z/io ) {
			push(@{$kw{'fre'}}, $keyword{'value'});
			}
		elsif ( $keyword{'lang'} =~ /^eng\z/io ) {
			push(@{$kw{'eng'}}, $keyword{'value'});
			}
		else	{
			push(@{$kw{'mul'}}, $keyword{'value'});
			}
		}
	if ( defined $kw{'fre'} and @{$kw{'fre'}} ) {
		$ligne = "FG : " . join(" ; ", @{$kw{'fre'}});
		push(@lignes, $ligne);
		}
	if ( defined $kw{'eng'} and @{$kw{'eng'}} ) {
		$ligne = "EG : " . join(" ; ", @{$kw{'eng'}});
		push(@lignes, $ligne);
		}
	if ( defined $kw{'mul'} and @{$kw{'mul'}} ) {
		$ligne = "OG : " . join(" ; ", @{$kw{'mul'}});
		push(@lignes, $ligne);
		}
	}

# Champ AI (Automatic Indexing)
if ( $indexation and $top{'keywords'} ) {
	my %keywords = %{$top{'keywords'}};
	if ( defined $keywords{'teeft'} ) {
		my @tmp = sort {length($a) <=> length($b) or $a cmp $b} @{$keywords{'teeft'}};
		my %tmp = ();
		for (my $nb = 0 ; $nb < $#tmp ; $nb ++) {
			if ( grep(/\b$tmp[$nb]\b/, @tmp[$nb + 1 .. $#tmp]) == 0 ) {
				$tmp{$tmp[$nb]} ++;
				}
			}
		$ligne = "AI : " . join(" ; ", grep {defined $tmp{$_}} @{$keywords{'teeft'}});
		push(@lignes, $ligne);
		}
	}

# Champ LO
$ligne = "NO : ISTEX $top{'id'}";
@tmp = ();
if ( $top{'pii'} ) {
	foreach my $item (@{$top{'pii'}}) {
		push(@tmp, "PII $item");
		}
	}
if ( $top{'pmid'} ) {
	foreach my $item (@{$top{'pmid'}}) {
		push(@tmp, "PMID $item");
		}
	}
if ( $top{'doi'} ) {
	foreach my $item (@{$top{'doi'}}) {
		push(@tmp, "DOI $item");
		}
	}
if ( @tmp ) {
	$ligne = "LO : " . join(" ; ", @tmp);
	push(@lignes, $ligne);
	}

return decoupe(@lignes);
}

sub decoupe
{
my @lignes = @_;
my @final = ();

foreach my $ligne (@lignes) {
	while ( length($ligne) > 78 ) {
		my $debut = "";
		if ( $ligne =~ /^.{40,77}\s/ ) {
			$debut = $&;
			$ligne = "     " . $';
			}
		else	{
			$debut = substr($ligne, 0, 78);
			$ligne = "     " . substr($ligne, 78);
			}
		push(@final, $debut);
		}
	push(@final, $ligne);
	}

return @final;
}

sub decoupe2
{
my $ligne = shift;
my @final = ();


while ( length($ligne) > 63 ) {
	my $debut = "";
	if ( $ligne =~ /^.{30,62}\s/ ) {
		$debut = $&;
		$ligne = $';
		}
	else	{
		$debut = substr($ligne, 0, 63);
		$ligne = substr($ligne, 78);
		}
	push(@final, $debut);
	}
push(@final, $ligne);

$ligne = join("\n" . " " x 15, @final) . "\n";

return $ligne;
}


__DATA__

##
## Liste des codes langues (ISO 639)
## NE PAS ÉDITER !
##

% LANGUES

AFR	Afrikaans
ALB	Albanais
AMH	Amharique
ARA	Arabe
ARM	Arménien
AZE	Azerbaïdjanais
BAK	Bachkir
BAS	Basque
BEL	Biélorusse
BEN	Bengali
BER	Berbère
BRE	Breton
BUL	Bulgare
BUR	Birman
CAM	Cambodgien
CAT	Catalan
CHI	Chinois
CRO	Croate
CZE	Tchèque
DAN	Danois
DUT	Néerlandais
ENG	Anglais
ESK	Eskimo
ESP	Espéranto
EST	Estonien
FAR	Feroien
FIN	Finnois
FLE	Flamand
FRE	Français
FRI	Frison
GAE	Gaélique
GEO	Géorgien
GER	Allemand
GRC	Grec (ancien)
GRE	Grec (moderne)
GUA	Guarani
GUJ	Goujrati
HAU	Hausa
HEB	Hébreu
HIN	Hindi
HUN	Hongrois
ICE	Islandais
ILO	Igbo
IND	Indonésien
INT	Interlingua
IRI	Irlandais
ITA	Italien
JAP	Japonais
JPN	Japonais
KAZ	Kazakh
KIR	Kirghiz
KON	Kongo
KOR	Coréen
KUR	Kurde
LAO	Laotien
LAP	Lapon
LAT	Latin
LAV	Letton
LIT	Lithuanien
LUB	Louba
MAC	Macédonien
MAY	Malais
MLA	Malgache
MOL	Moldave
MON	Mongol
MUL	Multilingue
NOR	Norvégien
PAN	Pendjabi
PER	Persan
POL	Polonais
POR	Portugais
PRO	Provencal
PUS	Pachto
QUE	Quechua
ROH	Romanche
RUM	Roumain
RUS	Russe
SER	Serbe
SHO	Chona
SLO	Slovaque
SLV	Slovène
SNH	Cingalais
SPA	Espagnol
SWA	Swahili
SWE	Suédois
TAG	Tagal
TAJ	Tamoul
THA	Thaï
TUK	Turkmène
TUR	Turc
UKR	Ukrainien
UND	Inconnue
URD	Ourdou
UZB	Ouzbek
VIE	Vietnamien
WEL	Gallois
WOL	Wolof
YOR	Yorouba

% FIN
