#!/usr/bin/perl -w

use locale;
use POSIX;
use Getopt::Long;
use strict;
no strict 'refs';

my $rcs = ' $Id: jargonixe,v 1.5 2002/01/21 01:28:11 gilles Exp gilles $ ' ;
$rcs =~ m/,v (\d+\.\d+)/;
my $VERSION = ($1) ? $1 : "UNKNOWN";
my $PROJECT_URL = "http://www.linux-france.org/prj/jargonixe";
my $urlpref = "http://www.linux-france.org/prj/jargonf/";

my ($jargonFile, $debug, $index, $bottom, $help);
my (%fics, %ficsUp);

GetOptions("jargon=s" => \$jargonFile,
           "debug"    => \$debug,
           "index!"   => \$index,
           "bottom!"  => \$bottom,
	   "help|h"   => \$help,
	  );

usage(), exit if $help;

sub usage {
        print <<EOF;
SYNOPSIS : The command "jargonixe" generates definitions taken from
the french jargon dictionary.  The words can come from stdin or from
files given in arguments. 
See also http://www.linux-france.org/prj/jargonf/

VERSION                 : $VERSION
USAGE                   : $0 [options] file1 file2 ...

OPTIONS:

 --help              : print the command usage (this message).
 --debug             : print debug information.
 --jargon     string : jargon file to use
                       default value is ./jargon.txt
 --(no)index         : generates an index at the top
                       on by default
 --(no)bottom        : generates a bottom §
                       on by default

ARGUMENTS:

 file1 file2 ...        : files to process, can be STDIN


EXAMPLES:
 echo "toto" | $0
 $0 toto.html
 cat toto.html | $0

EOF
}

my $locale = "fr_FR";
unless (setlocale(LC_ALL, $locale)) {
	warn "warning: could not set the locale to \"$locale\"\n",
	"         will have problems to find and convert Éé etc.\n";
}

# initialisations diverses et variées

$jargonFile = defined($jargonFile) ? $jargonFile : './jargon.txt';
$debug      = defined($debug)      ? $debug      : undef;
$index      = defined($index)      ? $index      : 1;
$bottom     = defined($bottom)     ? $bottom     : 1;

my ($rep, $prec_rep);
$rep = $prec_rep = "DIV";

# la boucle qui suit charge tout le jargon et stocke tout dans des hachages
open (JARGON, $jargonFile) || do {

	warn "Pas moyen d'ouvrir $jargonFile\n",
	"Essayez $0 --help\n";
	exit(1);
	
};
my ($mot, $rab);
while ( defined (my $lig = <JARGON>) ) {
	chomp ($lig);
	#warn "1 ", $lig,"\n";
	if ( index ($lig,":") == 0 ) { 
		# si la ligne commence par ":" c'est une nouvelle déf.
		#warn "2 ",$lig,"\n";
		$lig = substr ($lig,1);
		#my ($rab);
		if ( index ($lig, "#") != -1 ) {
			$rab = substr ($lig,index($lig,"#")+2);
			$mot = substr ($lig,0,index($lig,"#")-1);
			$lig =~ s/è/egrave/g; $lig =~ s/é/eacute/g;
			$lig =~ s/ë/euml/g;   $lig =~ s/ê/ecirc/g;
			$lig =~ s/î/icirc/g;  $lig =~ s/ï/iuml/g;
			$lig =~ s/ç/ccedil/g; $lig =~ s/à/agrave/g;
			$lig =~ s/â/acirc/g;  $lig =~ s/ù/ugrave/g;
			$lig =~ s/ü/uuml/g;   $lig =~ s/û/ucirc/g;
			$lig =~ s/ô/ocirc/g;  $lig =~ s/É/Ecirc/g;
			$lig =~ s/Â/Acirc/g;  $lig =~ s/À/Agrave/g;
			$lig =~ s/É/Eacute/g; $lig =~ s/\*/_etoile/g;
			$lig =~ s/µ/_mu/g;    $lig =~ s/$/_dollar/g;
			$lig =~ s/&/_amp/g;   $lig =~ s/~/_tilde/g;
			$lig =~ s/@/_at/g;    $lig =~ s/\?/_hein/g;
			$lig =~ s/!/_quoi/g;  $lig =~ s/:/_deuxpoints/g;
			$lig =~ s/;/_pointvirg/g; $lig =~ s/\'/_apos/g;
			$lig =~ s/ /_/g;	  $lig =~ s/\//_div/g;
			$lig =~ s/\(/_pg/g;	  $lig =~ s/\)/_pd/g;
			$lig = substr ($lig,0,index($lig,"#")-1);
		} else {
			$rab = "";	    $mot = $lig;
			$lig =~ s/è/egrave/g; $lig =~ s/é/eacute/g;
			$lig =~ s/ë/euml/g;	  $lig =~ s/ê/ecirc/g;
			$lig =~ s/î/icirc/g;  $lig =~ s/ï/iuml/g;
			$lig =~ s/ç/ccedil/g; $lig =~ s/à/agrave/g;
			$lig =~ s/â/acirc/g;  $lig =~ s/ù/ugrave/g;
			$lig =~ s/ü/uuml/g;	  $lig =~ s/û/ucirc/g;
			$lig =~ s/ô/ocirc/g;  $lig =~ s/É/Ecirc/g;
			$lig =~ s/Â/Acirc/g;  $lig =~ s/À/Agrave/g;
			$lig =~ s/É/Eacute/g; $lig =~ s/\*/_etoile/g;
			$lig =~ s/µ/_mu/g;	  $lig =~ s/$/_dollar/g;
			$lig =~ s/&/_amp/g;	  $lig =~ s/~/_tilde/g;
			$lig =~ s/@/_at/g;	  $lig =~ s/\?/_hein/g;
			$lig =~ s/!/_quoi/g;  $lig =~ s/:/_deuxpoints/g;
			$lig =~ s/;/_pointvirg/g;	    $lig =~ s/\'/_apos/g;
			$lig =~ s/ /_/g;      $lig =~ s/\//_div/g;
			$lig =~ s/\(/_pg/g;   $lig =~ s/\)/_pd/g;
		}
		$prec_rep = $rep;
		$rep = substr($lig,0,1); # détermination du nom du répertoire
		$rep =~ tr/a-z/A-Z/;
		if ( $rep lt "A" || $rep gt "Z") { $rep="DIV"; }
		my $fic = $rep . "/" . $lig . ".html"; # nom du fichier complet
		$fics{$mot} = $fic;
		++$ficsUp{"\L$mot"}{'num'};
		push (@{ $ficsUp{"\L$mot"}{'same'} }, $mot);
	} else {
		# sinon c'est la déf. 
		unless($lig =~ m/^¤¤/){
			$fics{$mot}{'def'} .= $lig if defined ($mot);
		}
		while ( defined (my $lig=<JARGON>) ) { # on récupère toute la déf
			chomp($lig);
			#warn "3 ",$lig,"\n";
			# on sort si on rencontre une ligne vide
			if ($lig eq "") { last };
			# éventuellement, les URL
			$lig =~ s/(.*)\<img.*?\>(.*)/$1$2/;
			if ($lig =~ /\<URL:/) {
				$lig=place_url($lig);
				
			}
			# a table begin
			elsif ($lig =~ /.*<table>$/i) {
				$lig .= "\n";	
			}
			# we are in a table
			elsif ($lig =~ /.*<\/tr>$/i) {
				$lig .= "\n";	
			}
			elsif ($lig =~ /.*[\.?!>:]$/) {
				$lig .= "<br>\n";	
			}else{
				$lig .= " ";	
			}
			$fics{$mot}{'def'} .= $lig if defined ($mot);
		}
	}
}

sub place_url {
	my ($ind,$url,$ligne);

	# on découpe la ligne (un seul URL par ligne)
	$ind=index($_[0],">");
	$url=substr($_[0],5,$ind-5);
	my $reste=substr($_[0],$ind+1);
	# on sauve pour la vérif et aussi pour l'index des URL
	$ligne="<a href=\"" . $url . "\">" . $url . "</a>" . $reste . "<BR>\n";
	return $ligne;
}


# Initialise the hash of terms
# key   = term
# value = url

my %terms;
my $maxLengthTerm = 0;

# read and compute input
while (<>) {
	# search for jargon declaration 
	# pattern: 
	while (m/\s*((\w|\/)+)\s*/g) {
		my $word = $1;
		next if exists($terms{$word});
		if (defined($fics{$word})) {
			$terms{$word} = $fics{$word};
			$maxLengthTerm  = max(length($word),
			                      $maxLengthTerm);
		}elsif (not exists($ficsUp{"\L$word"}{'num'})) {
			# $word is not in the jargon file
		}elsif ($ficsUp{"\L$word"}{'num'} == 1) {
			my $same = @{ $ficsUp{"\L$word"}{'same'} }[0];
			warn "warning: found a different case for [$word]:",
			"[$same]",
			"\n";
			$terms{$word}= $fics{$same};
			$maxLengthTerm  = max(length($word),
			                      $maxLengthTerm);
		}elsif ($ficsUp{"\L$word"}{'num'} > 1) {
			warn "WARNING: doublons for [$word]:[",
			join("][", @{$ficsUp{"\L$word"}{'same'}}),
			"]\n";
		}else{
			warn "WARNING: [$word] is too special";
		}
	}
}
# print header
print <<"END";
<!--
Generated by jargonixe $VERSION
-->
<BIG>Mode d\'emploi</BIG> : 
Les liens en <B>gras</B> dans l\'index et dans les définitions sont locaux à la page. 
Les autres liens renvoient au <A href="$urlpref">jargon</A> et nécessitent 
un accès à l\'internet.
<HR>
END

my %printed;


if ($index) {
	print "<BIG>\n";
	foreach my $term (sort keys(%terms)){
		unless ($printed{"\L$term"}) {
			print "<a href=\"#$term\">$term</a>\n";
			$printed{"\L$term"}++;
		}
	}
	print "</BIG>\n";
}

%printed = ();

foreach my $term (sort keys(%terms)){
	unless ($printed{"\L$term"}) {
		my $def = $terms{$term}{'def'};
		print "<a name=\"$term\"></a>\n";
		while ($def =~ s/¤(.*?)¤/&substlink($1)/eg){}
	        printf("<P>\n<BIG><A href=\"%s%s\">%s</A></BIG> : %s", 
		       $urlpref, $terms{$term}, $term, $def
		      ); 
		$printed{"\L$term"}++;
        }
}

sub substlink {
	my $word = shift(@_);
	if (defined($terms{$word})) {
		return("<B><A href=\"#$word\">$word<\/A></B>");
	}else{
		if (defined($fics{$word})){
			return("<A href=\"${urlpref}$fics{$word}\">$word<\/A>");	
		}else{
			return($word);
		}
	}
}

bottom() if ($bottom);

sub bottom {
setlocale(LC_TIME, $locale);
my $date = strftime("%c", localtime);
print <<"END";
<HR>

Généré le $date par <A href="$PROJECT_URL">jargonixe $VERSION</A>
<P>
END
}

sub max {
        my $max = shift(@_);
        my $foo;
        foreach $foo (@_) {
		#print "[$max][$foo]\n";
                $max = $foo if ($max < $foo);
        }
        return $max;
}