#!/usr/bin/perl
#
# fatfixml.pl       FATFIfi to eXtended Markup Language converter
# Author/Copyright: (C) 2012  O. Kellogg <okellogg@users.sourceforge.net>
# Version:          2017-03-12
#
# This file is part of GNACK, the GNU Ada CORBA Kit.
#
# GNACK 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.
#
# GNACK 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#

use strict;

sub str2xml;

my $envelope = "";
my $mainname = "";
my $infile = "";
while (@ARGV) {
  my $arg = shift @ARGV;
  if ($arg eq "-e") {
    $envelope = shift @ARGV;
  } elsif ($arg eq "-t") {
    $mainname = shift @ARGV;
  } elsif ($arg =~ /^-/) {
    $arg =~ /^-h/ or warn "Unknown option $arg\n";
    warn "Options:\n";
    warn "  -t MAINNAME      Use MAINNAME when the outer type is unknown\n";
    warn "  -e '<ENVELOPE>'  Use <ENVELOPE> as the outer XML tag (default: <file>)\n";
    exit($arg !~ /^-h/);
  } else {
    $infile = $arg;
    last;
  }
}
$infile or die "fatfixml.pl : supply input file name\n";
open(IN, "< $infile") or die "fatfixml.pl : cannot open input file\n";
unless ($mainname) {
  $mainname = $infile;
  $mainname =~ s@^.*/@@;
  $mainname =~ s/\..*$//;
}
print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
unless ($envelope) {
  $envelope = "<file name=\"${mainname}.xml\">";
}
print "$envelope\n";
my $indent = "  ";
my @stack = ();
while (<IN>) {
    my $line = $_;
    chop $line;
    if ($line =~ /^ *(--|#)/) {
        $line =~ s/^ *(--|#)//;
        print "$indent<!-- ${line} \-\->\n";
        next;
    }
    $line =~ s/,$//;
    $line =~ s/\s+$//;
    if ($line =~ /^ *$/) {
        print "\n";
    } elsif ($line =~ /^ *\)/) {
        @stack or die "internal error: attribute stack empty at line $.\n";
        my $name = pop @stack;
        $line =~ s/\)$//;
        if ($name =~ /^\d/) {
          print "$indent$line</element>\n";
        } else {
          print "$indent$line</$name>\n";
        }
    } elsif ($line =~ /\($/) {
        $line =~ s/ *\($//;
        $line =~ s/ *=>$//;
        my $name = $line;
        $name =~ s/^ *//;
        if (length($name) == 0) {
          $name = $mainname;   # make synthetic name
        }
        # use $line for indentation only (remove all other contents)
        if ($line =~ /^\w/) {
          $line = "";
        } else {
          $line =~ s/[^ ].*$//;
        }
        if ($name =~ /^\d/) {
          print "$indent$line<element index=\"$name\">\n";
          $name = "element";
        } else {
          $name =~ s/::/./g;
          print "$indent$line<$name>\n";
        }
        push @stack, $name;
    } elsif ($line !~ /^ *\w/) {
        print "$indent<!\-\- ${line} \-\->\n";
    } elsif ($line !~ /=>/) {
        warn "converting line $. to comment: $line\n";
        print "$indent<!\-\- ${line} \-\->\n";
    } else {
        my @name_and_value = split(/ *=> */, $line);
        $name_and_value[0] =~ s/^ *//;
        my $name = $name_and_value[0];
        my $value = $name_and_value[1];
        if ($value =~ /^"/) {
            $value = str2xml($value);
        }
        # use $line for indentation only (remove all other contents)
        $line =~ s/[^ ].*$//;
        if ($name =~ /^\d/) {
          print "$indent$line<element index=\"$name\">$value</element>\n";
        } else {
          print "$indent$line<$name>$value</$name>\n";
        }
    }
}
$envelope =~ s/^<//;
$envelope =~ s/ .*$//;
$envelope =~ s/>$//;
print "</$envelope>\n";
close(IN);

# Precondition: $str must be a string (embedded in quotation marks)
sub str2xml {
    my $str = shift;
    $str = substr($str, 1, length($str) - 2);
    $str =~ s/\&/&amp;/g;
    $str =~ s/</&lt;/g;
    $str =~ s/>/&gt;/g;
    $str =~ s/\\"/&quot;/g;
    return '"' . $str . '"';
}

1;

# The End.

# Local Variables:
# cperl-indent-level: 4
# indent-tabs-mode: nil
# End: