1#!/usr/bin/perl -w 2 3use strict; 4 5#sub log_err {warn @_;} 6sub log_err {} 7 8# read in the .atlas header 9 10die "No ATLAS line\n" unless <STDIN> =~ /^ATLAS/; 11die "No IWILL line\n" unless <STDIN> =~ /^IWILL/; 12 13# spit out the .def header 14 15print("#Modeline for XEmacs: -*-Python-*-\n"); 16 17# main parse loop 18 19# a stack to keep track of whether we're inside an array, map, or whatever 20my @parse_type; 21 22# don't put brackets around multi-line arrays 23my @multi_line_array; 24my $started_multi_line_array; 25 26# call when you finish an element 27sub push_done_type { 28 return if(!@parse_type); 29 if ($parse_type[-1] eq "map_have_key") { 30 pop @parse_type; 31 } elsif ($parse_type[-1] ne "in_array") { 32 die "In invalid state $parse_type[-1] at end of element\n"; 33 } 34 push @parse_type, "need_sep"; 35 log_err "Parse type stack is now:"; 36 foreach(@parse_type) {log_err " $_";} 37 log_err "\n"; 38 39 $started_multi_line_array = 0; 40}; 41 42sub indent { my $space = (@parse_type - (shift or 0)) - @multi_line_array; print " " while $space--; }; 43 44sub valid_parse_type {return @parse_type ? $parse_type[-1] : "none";} 45 46# Allow repeated passes through the loop for a single line, for cases 47# like '{ foo:[""], bar:0 }, {' 48LINE: while(my $line = <STDIN>) { 49 50 # ignore comments 51 next LINE if $line =~ /^#/; 52 53 while($line) { 54 # remove leading whitespace 55 $line =~ s/^\s+//gm if !@parse_type or $parse_type[-1] ne "in_string"; 56 next LINE if !$line; 57 58 if(!@parse_type or $parse_type[-1] eq "map_have_key" or $parse_type[-1] eq "in_array") { 59 log_err "Starting new element\n"; 60 # start new element 61 $line =~ s/^(.)//; 62 my $char = $1; 63 if($char eq "{") { # starting a map 64 log_err "Staring a map\n"; 65 # We print a \n at the beginning of a multi-line array, so don't here 66 print "\n" unless @multi_line_array and $multi_line_array[-1] == @parse_type - 1 and $started_multi_line_array; 67 push @parse_type, "in_map"; 68 indent(1); 69 print ":map:\n"; 70 } elsif ($char eq "[") { # starting an array 71 log_err "Staring a array\n"; 72 if (!$line or $line =~ /^[{\n]/) { 73 # multi_line_array 74 my $place = @parse_type; # scalar cast 75 log_err "Starting multi line array at depth $place\n"; 76 push @multi_line_array, $place; 77 print "\n"; 78 $started_multi_line_array = 1; 79 } else { 80 print "["; 81 } 82 push @parse_type, "in_array"; 83 } elsif ($char eq "]") { # finished an array, either a trailing comma or empty 84 log_err "Finished an array\n"; 85 pop @parse_type; 86 if(@multi_line_array and @parse_type == $multi_line_array[-1]) { 87 log_err "Finished multi line array at depth $multi_line_array[-1]\n"; 88 pop @multi_line_array; 89 } elsif(@multi_line_array and @parse_type < $multi_line_array[-1]) { 90 die "Ending array at depth @parse_type, deepest multi line array is at $multi_line_array[-1]\n"; 91 } else { 92 print "]"; 93 } 94 push_done_type(); 95 } elsif ($char eq "\"") { # starting a string 96 log_err "Staring a string\n"; 97 indent() if @multi_line_array and $multi_line_array[-1] == @parse_type - 1; 98 push @parse_type, "in_string"; 99 print "\""; 100 } 101 elsif ($char =~ /[0-9]/) { # starting a number 102 log_err "Staring a number\n"; 103 indent() if @multi_line_array and $multi_line_array[-1] == @parse_type - 1; 104 # print the digits 105 $line =~ s/^([0-9.]*)//; 106 print "$char$1"; 107 push_done_type(); 108 } 109 else { 110 # $line still has a trailing \n, don't add one to 'die' statement 111 die "Invalid element $1$line"; 112 } 113 } elsif ($parse_type[-1] eq "in_map") { 114 if($line =~ /^\}/) { # finished a map, either a trailing comma or empty 115 $line =~ s/^.//; 116 pop @parse_type; # remove "in_map" 117 push_done_type(); 118 } else { 119 die "Couldn't find key string in map" 120 unless $line =~ s/([A-Za-z_]+:)//; 121 log_err "Got key $1\n"; 122 indent(); 123 # some keys had name changes 124 if($1 eq "summary:") { 125 print "description:"; 126 } elsif($1 eq "description:") { 127 print "long_description:"; 128 } elsif($1 eq "arg_description:") { 129 print "args_description:"; 130 } elsif($1 eq "arg:") { 131 print "args:"; 132 } else { print $1; } 133 push @parse_type, "map_have_key"; 134 } 135 } elsif ($parse_type[-1] eq "need_sep") { 136 pop @parse_type; # remove "need_sep" 137 $line =~ s/^(.)//; 138 log_err "Printed separator $1 leaving parse type " . valid_parse_type() ."\n"; 139 if($1 eq "]") { 140 log_err "Got a ]\n"; 141 die "Ended map with ]" unless $parse_type[-1] eq "in_array"; 142 pop @parse_type; # remove "in_array" 143 if(@multi_line_array and @parse_type == $multi_line_array[-1]) { 144 log_err "Finished multi line array at depth $multi_line_array[-1]\n"; 145 pop @multi_line_array; 146 } elsif(@multi_line_array and @parse_type < $multi_line_array[-1]) { 147 die "Ending array at depth @parse_type, deepest multi line array is at $multi_line_array[-1]\n"; 148 } else { 149 print "]"; 150 } 151 push_done_type(); 152 } elsif($1 eq "}") { 153 log_err "Got a }\n"; 154 die "Ended array with }" unless $parse_type[-1] eq "in_map"; 155 pop @parse_type; # remove "in_map" 156 push_done_type(); 157 } elsif ($1 eq ",") { 158 if (@parse_type == 1 || $parse_type[-1] eq "in_map") { 159 print "\n"; # toplevel array, maps 160 } else { 161 print ", "; # deeper array levels 162 } 163 } else { 164 die "Invalid array continuation $1$line"; 165 } 166 log_err "After checking separator, parse type is " . valid_parse_type() . "\n"; 167 } elsif(@parse_type and $parse_type[-1] eq "in_string") { 168 print $1 while $line =~ s/([^\"]\\\")//; 169 if($line =~ /([^\"]*\")(.*)/) { 170 log_err "Printing string \"$1, remainder of line is \"$2\"\n"; 171 # handle a changed opname, hopefully this won't mess up anything else 172 my $out = $1 eq "communication\"" ? "communicate\"" : $1; 173 print $out; 174 $line = $2; 175 pop @parse_type; 176 push_done_type(); 177 log_err "After printing string, parse type is " . valid_parse_type() . "\n"; 178 } else { 179 print $line; 180 $line = ""; 181 } 182 } else { 183 die "Invalid parse type $parse_type[-1]\n"; 184 } 185 } 186} 187 188# fix no-newline-at-end-of-file 189print "\n"; 190 191die "Still in state $parse_type[-1], unmatched brackets\n" if @parse_type; 192