use Text::Balanced qw ( :ALL );
use Data::Dumper;

$DELIM = '(){}[]<>';

print <<EOF;
<commands>
EOF
$curcmd = "";
$cmd = "";
while (<>)
{
    chop;
    if (/^Usage/)
    {
        &mkparts($cmd,$curcmd) if ($cmd ne "");
        $curcmd = "";
        $cmd = "";
        s/^Usage:\s+//;
        s#^([^\s]+)\s*(\|\s*([^\s]+)\s*)?##; # deal with alternate names
        $cmd = $1;
        $curcmd = $_;
    }
    elsif (m/^       $cmd/) #alternate form of command
    {
        s#^       $cmd##;
        &mkparts($cmd,$curcmd);
        $curcmd = $_;
    }
    else
    {
        $curcmd .= " ". $_;
    }
}
if ($cmd ne "")
{
    &mkparts($cmd,$curcmd);
}
print <<EOF;
</commands>
EOF

exit 0;


sub mkparts
{
    local($cmd,$line) = @_;
    local(@parts,$map,$midx);
    print <<EOF;
    <subcommand cmd='$cmd'>
EOF
    print "<!-- $cmd $line -->\n";
    local($hb);
    $hb = &handle_bracketed($line,0);
    print "<!-- mapping $hb->{m} -->\n";
    #print "m_array", Dumper($hb->{m_array});
    #print Dumper(\@{$hb->{parts}});
    print <<EOF;
    </subcommand>
EOF
    return;

    $map = $hb->{m};
    $extracted = "";
    $midx = 0;
    while( $map)
    {

            print "map: $map ";
            @ext =   extract_multiple($map,
                                          [ \&extract_bracketed,
                                            qr/[^<([{]*/,
                                          ]);
            print "ext = @ext\n";
            if ($map=~ m#^[<([{]#)
            {
                ($extracted, $map) = &extract_bracketed($map, $DELIM);
                $extracted =~ s#^\((.*)\)$#$1#;
                $midx++;
                $paren=1;
            }
            else
            {
                $map =~ s#^([^<([{]*)##;
                $extracted= $1;
                $paren=0;
            }

            #if ($extracted ) 
            print " extracted: $extracted\n";
    }
    return;

}

sub handle_bracketed
{
    local($str,$gut) = @_;
    local($tree) = { parts => [],
                     m_array => []
    };
    local($word);
    #if ($str =~ m#^([[{(<])#) #lll
    if ($gut)
    {
        $str =~ s/^([[{(<])(.*).$/$2/;
        $brace = $1;
        $$tree{brace} = $brace;
    }
    $$tree{m} = "";

    while($str)
    {
        $str =~ s#^\s*##g;
        if ($str =~ m#^([[{(<])#)
        {
            ($extracted, $str) = &extract_bracketed($str,$DELIM);
            #print "extracted: $extracted\n"; 
            #print "str: $str\n"; 
            local($hb);
            print "   <brace>\n";
            push(@{$tree->{parts}}, $hb = &handle_bracketed($extracted,1));
            print "   </brace>\n";

            #$$tree{m} .= "V" ; # Down arrow, recursion
            $$tree{m} .= "(".$hb->{m}.")"; # Down arrow, recursion
            push(@{$tree->{m_array}},$hb);
            if ($#{$hb->{m_array}} > -1)
            {
                push(@{$tree->{m_array}},@{$hb->{m_array}});
            }
            else
            {
                push(@{$tree->{m_array}},@{$hb->{parts}});
            }
            push(@{$tree->{m_array}},$hb);
        }
        elsif ($str =~ m#^([^\s|,.[({<]+)\s*#)
        {
            $str =~ s#^([^\s|,.[({<]+)\s*##;
            $word = $1;
            $word =~ s#["']+##g;
            push(@{$tree->{parts}},$word);
            push(@{$tree->{m_array}},$word);
            if ($word =~ m#^-#)
            {
                print "    <flag name='$word'/>\n";
                $$tree{m} .= "f"; # flag 
            }
            else
            {
                print "    <word name='$word'/>\n";
                $$tree{m} .= "w"; # plain word
            }
        }
        elsif ($str =~ m#^[|,:]#)
        {
            $char=$&;
            $tag = "or";
            $tag = "const char='$char'" if $str =~ m#^[,:]#;
            print "    <$tag/>\n";
            $str =~ s#^([|,:])\s*##;
            push(@{$tree->{parts}},$1);
            push(@{$tree->{m_array}},$1);
            $$tree{m} .= "$1";
        }
        elsif ($str =~ m#^\.\.\.#)
        {
            print "    <ellipses/>\n";
            $str =~ s#^\.\.\.\s*##;
            push(@{$tree->{parts}},"...");
            push(@{$tree->{m_array}},"...");
            $$tree{m} .= "e"; # Ellipses
        }
    }

    return $tree;
}