#! /usr/bin/perl -w
#
#   Based on conv.py, which is GPL
#   Copyright (C) 2002 John Goerzen
#
#   Rewrite in perl by
#   Copyright (C) 2004-2007  Roland Rosenfeld <roland@spinnaker.de>
#
#   This program is free software; you can redistribute it and/or
#   modify it under the terms of the GNU General Public License as
#   published by the Free Software Foundation; either version 2 of
#   the License, or (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
#   General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: conv.pl,v 1.9 2007/04/29 15:04:25 roland Exp $
#

use strict;
my $reverse = 0;
if (($#ARGV>=0) && ($ARGV[0] eq '-r')) {
   $reverse = 1;
   $ARGV = shift;
}

while (<>) {
   if (/^\#/) {
      print;
      next;
   }
   if (! /::/) {
      next;
   }
   chomp;
   my ($entry, $definition) = split / :: /;
   if (($entry =~ /^\s*$/) || ($definition =~ /^\s*$/)) {
      next;
   }
   if ($entry =~ / : /) {
      my ($eshort, $elong) = split / : /, $entry;
      if ($definition !~ / : /) {
	  $definition = "- : $definition";
      }
      my ($dshort, $dlong) = split / : /, $definition;
      if ($reverse) {
	 doall ("$dshort : $dlong", "$eshort : $elong") unless $dshort eq '-';
	 doall ("$dlong : $dshort", "$elong : $eshort") unless $dlong eq '-';
      } else {
	 doall ("$eshort : $elong", "$dshort : $dlong") unless $eshort eq '-';
	 doall ("$elong : $eshort", "$dlong : $dshort") unless $elong eq '-';
      }
   } else {
      if ($reverse) {
	 doall ($definition, $entry);
      } else {
	 doall ($entry, $definition);
      }
   }
}

sub doall {
   my ($entry, $definition) = @_;
   my @elist = split /\|/, $entry;
   my @dlist = split /\|/, $definition;
   if ($#elist != $#dlist) {
      print STDERR "Fehler: $entry :: $definition\n";
      next;
   }
   for (my $i=0; $i<=$#elist; $i++) {
      $entry = $elist[$i];
      $definition = $dlist[$i];
      for ($entry, $definition) {
	 s/^\s+//;
	 s/\s+$//;
      }
      if ($entry eq '' || $definition eq '') {
	 next;
      }
      $entry =~ s/^to //;
      printdef ($entry, $definition);
   }
}

sub printdef {
   my ($entry, $definition) = @_;
   my @entrylist = splitentry($entry);
   #my $combine = join('; ', @entrylist);
   #if ($entry ne $combine) {
   #   print STDERR "$entry => $combine\n";
   #}
   foreach $entry (@entrylist) {
      my $comment = '';
      # move heading () after the main entry:
      $entry =~ s/^(\([^\)]+\))\s*([^\[\{\(]+)/$2 $1/;
      if ($entry =~ /[\[\(\{]| : /) {
	 ($entry, $comment) = $entry =~ /^([^\[\(\{]*)(([\[\(\{]| : ).*)$/;
      }
      for ($entry, $comment) {
	 s/^\s+//;
	 s/\s+$//;
      }
      if ($comment ne '') {
	 $comment = " $comment";
      }
      if (! ($entry =~ /\w/)) {
	 next;
      }
      if ($entry =~ /^:/) {
	 next;
      }
      if ($entry =~ /^\s*\(.*\)\s*$/) {
	 next;
      }
      print ":$entry:$comment\n";
      print "   $definition\n";
   }
}

sub splitentry {
   my ($entry) = @_;
   my @entrylist = ();
   my $rest = $entry;
   $entry = '';
   while ($rest ne '') {
      $rest =~ /^([^;\(\{]*)(.*)$/;
      $entry .= $1;
      $rest = $2;
#      print STDERR "entry='$entry', rest='$rest'\n";
      if ($rest =~ /^;/) {
	 push @entrylist, $entry;
	 $rest =~ s/^;\s*//;
	 $entry = '';
      } elsif ($rest =~ /^(\([^\)]*\))(.*)$/) {
	 $entry .= $1;
	 $rest = $2;
      } elsif ($rest =~ /^(\{[^\}]*\})(.*)$/) {
	 $entry .= $1;
	 $rest = $2;
      } else {
	 # "(" without ")"
	 $entry .= $rest;
	 push @entrylist, $entry;
	 $rest = '';
	 $entry = '';
      }
   }
   if ($entry ne '') {
      push @entrylist, $entry;
   }
   return @entrylist;
}