3 # converts the <rules>.xml file to the old format <rules>.lst file
7 # perl xml2lst.pl < filename.xml > filename.lst
11 $doc = new_document( 0, '');
14 ($reg) = node_by_name($doc, '/xkbConfigRegistry');
15 @models = node_by_name($reg, 'modelList/model/configItem');
16 @layouts = node_by_name($reg, 'layoutList/layout/configItem');
17 @options = node_by_name($reg, 'optionList/group/configItem');
21 ($name) = node_by_name($i, 'name');
22 ($descr) = node_by_name($i, 'description');
23 printf(" %-15s %s\n", text_child($name), text_child($descr));
28 ($name) = node_by_name($i, 'name');
29 ($descr) = node_by_name($i, 'description');
30 printf(" %-15s %s\n", text_child($name), text_child($descr));
33 print "\n! variant\n";
35 ($lname) = node_by_name($l, 'name');
36 @variants = node_by_name($l, '../variantList/variant/configItem');
38 ($name) = node_by_name($v, 'name');
39 ($descr) = node_by_name($v, 'description');
40 printf(" %-15s %s: %s\n",
41 text_child($name), text_child($lname), text_child($descr));
47 ($name) = node_by_name($g, 'name');
48 ($descr) = node_by_name($g, 'description');
49 printf(" %-20s %s\n", text_child($name), text_child($descr));
51 @opts = node_by_name($g, '../option/configItem');
53 ($name) = node_by_name($o, 'name');
54 ($descr) = node_by_name($o, 'description');
56 text_child($name), text_child($descr));
61 local ($nodelist, $attrexpr) = @_;
62 local ($attr, $value) = split (/=/, $attrexpr);
63 local ($node, $attrvalue);
64 if (defined $value && $value ne '') {
66 foreach $node (@{$nodelist}) {
67 $attrvalue = node_attribute($node, $attr);
68 if (defined $attrvalue && $attrvalue eq $value) {
73 foreach $node (@{$nodelist}) {
74 if (! defined node_attribute($node, $attr)) {
86 my (@node_stack, $parent);
92 @str = split /([<>])/;
93 shift @str if ($str[0] eq '' || $str[0] =~ /^[ \t]*$/);
100 add_text_node($parent, $text);
103 } elsif ($token eq '>') {
105 if ($tag =~ /^\/(.*)/) { # close tag
106 $parent = pop @node_stack;
107 } elsif ($tag =~ /^([^\/]*)\/$/) {
108 empty_tag($parent, $1);
110 if (defined ($node = open_tag($parent, $tag))) {
111 push @node_stack, $parent;
125 $text .= "\n" . $token;
136 $doc = new_node( 0, '', 'DOCUMENT');
137 $doc->{CHILDREN} = [];
142 local ($parent_node, $tag, $type) = @_;
145 $node{PARENT} = $parent_node;
148 if ($type eq 'COMMENT' || $type eq 'TEXT') {
154 local ($tname, $attr) = split(' ', $tag, 2);
155 $node{NAME} = $tname;
157 if (defined $attr && $attr ne '') {
159 local @attr_list = split ( /"/, $attr);
160 local ($name, $value);
161 while (scalar @attr_list) {
162 $name = shift @attr_list;
164 next if ($name eq '');
165 $value = shift @attr_list;
166 $attr_table{$name} =$value;
168 $node{ATTRIBUTES} = \%attr_table;
174 local ($parent_node, $node) = @_;
175 push @{$parent_node->{CHILDREN}}, $node;
177 local $tname = $node->{NAME};
178 if (defined $parent_node->{$tname}) {
179 push @{$parent_node->{$tname}}, $node
181 $parent_node->{$tname} = [ $node ];
186 local ($parent_node, $tag) = @_;
187 local $node = new_node($parent_node, $tag, 'EMPTY');
188 add_node($parent_node, $node);
192 local ($parent_node, $tag) = @_;
195 if ($tag =~ /^\?.*/ || $tag =~ /^\!.*/) {
196 $node = new_node($parent_node, $tag, 'COMMENT');
197 add_node($parent_node, $node);
200 $node = new_node($parent_node, $tag, 'NODE');
201 $node->{CHILDREN} = [];
202 add_node($parent_node, $node);
208 local ($parent_node, $text) = @_;
209 local $node = new_node($parent_node, $text, 'TEXT');
210 add_node($parent_node, $node);
214 local ($node, $name) = @_;
215 local ($tagname, $path) = split(/\//, $name, 2);
219 if ($tagname eq '') {
220 while ($node->{PARENT} != 0) {
221 $node = $node->{PARENT};
223 sublist_by_name($node, $path, \@nodelist);
225 sublist_by_name($node, $name, \@nodelist);
230 sub sublist_by_name {
231 local ($node, $name, $res) = @_;
232 local ($tagname, $path) = split(/\//, $name, 2);
234 if (! defined $path) {
235 push @{$res}, (@{$node->{$tagname}});
239 if ($tagname eq '..' && $node->{PARENT} != 0) {
240 $node = $node->{PARENT};
241 sublist_by_name($node, $path, $res);
244 for $n (@{$node->{$tagname}}) {
245 sublist_by_name($n, $path, $res);
252 if (defined $node->{ATTRIBUTES}) {
253 return $node->{ATTRIBUTES}{@_[1]};
260 local ($child) = node_by_name($node, 'TEXT');
261 return $child->{TEXT};