use Text::Balanced qw ( :ALL );
use Data::Dumper;
$DELIM = '(){}[]<>';
print <
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
exit 0;
sub mkparts
{
local($cmd,$line) = @_;
local(@parts,$map,$midx);
print <
EOF
print "\n";
local($hb);
$hb = &handle_bracketed($line,0);
print "\n";
#print "m_array", Dumper($hb->{m_array});
#print Dumper(\@{$hb->{parts}});
print <
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 " \n";
push(@{$tree->{parts}}, $hb = &handle_bracketed($extracted,1));
print " \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 " \n";
$$tree{m} .= "f"; # flag
}
else
{
print " \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 " \n";
$str =~ s#^\.\.\.\s*##;
push(@{$tree->{parts}},"...");
push(@{$tree->{m_array}},"...");
$$tree{m} .= "e"; # Ellipses
}
}
return $tree;
}