The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/bin/perl

# xml2ogdl <file.xml> [file.g]
#
# author 'Rolf Veen'
# license zlib
# date 20030902

use XML::Parser;

($file, $ofile) = @ARGV;
my $level = 0;
my $pending = 0;

$xp = new XML::Parser(Handlers => {Start => \&start_handler,
                                  End   => \&end_handler,
                                  Char  => \&char_handler});

die "can't create XML::Parser object; $!\n"
   unless $xp;

if (! $file) {
    print("usage:  xml2ogdl <file.xml> [file.g]\n");
    exit();
}

if ($ofile) {
    open(OX,">$ofile");
}
else {
    *OX = STDOUT;
}

$xp->parsefile($file);


sub start_handler
{
   my ($xp, $elem, %attr) = @_;

   $pending = print_str($elem,$level*2,$pending,*OX);
   if (%attr) {
       while ( my($key,$value) = each(%attr) ) {
           $pending = print_str($key,$level*2+2,$pending,*OX);
           $pending = print_str($value,$level*2+4,$pending,*OX);
       }
   
   }
   $level++;
}

sub end_handler
{
   my ($xp, $elem) = @_;

   $level--;
}

sub char_handler
{
   my ($xp, $str) = @_;
   
   # if empty line, ignore
   if (emptyLine($str)) { return; }

   $pending = print_str($str,$level*2,$pending,*OX);
}

sub emptyLine
{
    my $n = length($_[0]);
    
    for ($i=0; $i<$n; $i++) {
        my $c = substr($_[0],$i,1);
        if ( _isWordChar($c) ) {
            return 0;
        }
    }  
    return 1; 
}


sub _isWordChar
{
    if ($_[0] =~ /[ \t\n\r]/) { return 0; }
    return 1;
}

sub print_str 
{
    my $s = $_[0];
    my $n = $_[1];
    $pending = $_[2];
    
    local *OFILE;
    if ($_[3]) { *OFILE = $_[3]; }
    else { *OFILE = STDOUT; }
    
    # see what type of string it is: word, quoted or block
    if ($s =~ /[\n\r]/) {
        print OFILE " \\\n";
        my $c;
        my $i=0;
        my $pend=1;

        while ( $c = substr($s,$i,1) ) {
            if ( $pend == 1 ) { print OFILE ' ' x $n; $pend = 0;}
            print OFILE $c;
            if ($c eq "\n") {
                $pend = 1;
            }
            $i++;
        }
        $pending = 0;
    }
    elsif ($s =~ / /) {
        if ($pending == 1) { print OFILE "\n" }
        print OFILE ' ' x $n;
        print OFILE '"' . $s . '"';
        $pending = 1;
    }
    else {
        if ($pending == 1) { print OFILE "\n" }
        print OFILE ' ' x $n;
        print OFILE $s;
        $pending = 1;
    }
    return $pending;
}