xml2lst.pl revision 154daed1 
1#!/usr/bin/perl
2
3# converts the <rules>.xml file to the old format <rules>.lst file
4#
5# Usage:
6#
7# perl xml2lst.pl [lang] < filename.xml > filename.lst
8#
9# author Ivan Pascal
10
11if (@ARGV) {
12   $lang = shift @ARGV;
13} else {
14   $lang = '';
15}
16
17$doc = new_document( 0, '');
18parse('', $doc);
19
20($reg)   = node_by_name($doc, '/xkbConfigRegistry');
21@models  = node_by_name($reg, 'modelList/model/configItem');
22@layouts = node_by_name($reg, 'layoutList/layout/configItem');
23@options = node_by_name($reg, 'optionList/group/configItem');
24
25print "! model\n";
26for $i (@models) {
27   ($name) = node_by_name($i, 'name');
28    @desc =  node_by_name($i, 'description');
29    $descr = with_attribute(\@desc, 'xml:lang='.$lang);
30    if (! defined $descr) {
31        $descr = with_attribute(\@desc, 'xml:lang=');
32    }
33    printf("  %-15s %s\n", text_child($name), text_child($descr));
34}
35
36print "\n! layout\n";
37for $i (@layouts) {
38   ($name) = node_by_name($i, 'name');
39    @desc =  node_by_name($i, 'description');
40    $descr = with_attribute(\@desc, 'xml:lang='.$lang);
41    if (! defined $descr ) {
42        $descr = with_attribute(\@desc, 'xml:lang=');
43    }
44    printf("  %-15s %s\n", text_child($name), text_child($descr));
45}
46
47print "\n! variant\n";
48for $l (@layouts) {
49   ($lname) = node_by_name($l, 'name');
50    @variants = node_by_name($l, '../variantList/variant/configItem');
51    for $v (@variants) {
52      ($name) = node_by_name($v, 'name');
53       @desc  = node_by_name($v, 'description');
54       $descr = with_attribute(\@desc, 'xml:lang='.$lang);
55       if (! defined $descr) {
56           $descr = with_attribute(\@desc, 'xml:lang=');
57       }
58       printf("  %-15s %s: %s\n",
59               text_child($name), text_child($lname), text_child($descr));
60    }
61}
62
63print "\n! option\n";
64for $g (@options) {
65   ($name) = node_by_name($g, 'name');
66    @desc =  node_by_name($g, 'description');
67    $descr = with_attribute(\@desc, 'xml:lang='.$lang);
68    if (! defined $descr) {
69        $descr = with_attribute(\@desc, 'xml:lang=');
70    }
71    printf("  %-20s %s\n", text_child($name), text_child($descr));
72
73    @opts = node_by_name($g, '../option/configItem');
74    for $o (@opts) {
75      ($name) = node_by_name($o, 'name');
76       @desc  = node_by_name($o, 'description');
77       $descr = with_attribute(\@desc, 'xml:lang='.$lang);
78       if (! defined $descr) {
79           $descr = with_attribute(\@desc, 'xml:lang=');
80       }
81       printf("  %-20s %s\n",
82               text_child($name), text_child($descr));
83    }
84}
85
86sub with_attribute {
87    local ($nodelist, $attrexpr) = @_;
88    local ($attr, $value) = split (/=/, $attrexpr);
89    local ($node, $attrvalue);
90    if (defined $value && $value ne '') {
91        $value =~ s/"//g;
92        foreach $node (@{$nodelist}) {
93           $attrvalue = node_attribute($node, $attr);
94           if (defined $attrvalue && $attrvalue eq $value) {
95               return $node;
96           }
97        }
98    } else {
99        foreach $node (@{$nodelist}) {
100           if (! defined node_attribute($node, $attr)) {
101               return $node;
102           }
103        }
104    }
105    undef;
106}
107
108# Subroutines
109
110sub parse {
111   local $intag = 0;
112   my (@node_stack, $parent);
113   $parent = @_[1];
114   local ($tag, $text);
115
116   while (<>) {
117      chomp;
118      @str = split /([<>])/;
119      shift @str if ($str[0] eq '' || $str[0] =~ /^[ \t]*$/);
120
121      while (scalar @str) {
122         $token = shift @str;
123         if ($token eq '<') {
124            $intag = 1;
125            if (defined $text) {
126               add_text_node($parent, $text);
127               undef $text;
128            }
129         } elsif ($token eq '>') {
130            $intag = 0;
131            if ($tag =~ /^\/(.*)/) { # close tag
132               $parent = pop @node_stack;
133            } elsif ($tag =~ /^([^\/]*)\/$/) {
134               empty_tag($parent, $1);
135            } else {
136               if (defined ($node = open_tag($parent, $tag))) {
137                  push @node_stack, $parent;
138                  $parent = $node;
139               }
140            }
141            undef $tag;
142         } else {
143            if ($intag == 1) {
144               if (defined $tag) {
145                  $tag .= ' '. $token;
146               } else {
147                  $tag = $token;
148               }
149            } else {
150               if (defined $text) {
151                  $text .= "\n" . $token;
152               } else {
153                  $text = $token;
154               }
155            }
156         }
157      }
158   }
159}
160
161sub new_document {
162   $doc = new_node( 0, '', 'DOCUMENT');
163   $doc->{CHILDREN} = [];
164   return $doc;
165}
166
167sub new_node {
168  local ($parent_node, $tag, $type) = @_;
169
170  my %node;
171  $node{PARENT} = $parent_node;
172  $node{TYPE} = $type;
173
174  if ($type eq 'COMMENT' || $type eq 'TEXT') {
175     $node{TEXT} = $tag;
176     $node{NAME} = $type;
177     return \%node;
178  }
179
180  local ($tname, $attr) = split(' ', $tag, 2);
181  $node{NAME} = $tname;
182
183  if (defined $attr && $attr ne '') {
184     my %attr_table;
185     local @attr_list = split ( /"/, $attr);
186     local ($name, $value);
187     while (scalar @attr_list) {
188        $name = shift @attr_list;
189        $name =~ s/[ =]//g;
190        next if ($name eq '');
191        $value =  shift @attr_list;
192        $attr_table{$name} =$value;
193     }
194     $node{ATTRIBUTES} = \%attr_table;
195  }
196  return \%node;
197}
198
199sub add_node {
200  local ($parent_node, $node) = @_;
201  push @{$parent_node->{CHILDREN}}, $node;
202
203  local $tname = $node->{NAME};
204  if (defined $parent_node->{$tname}) {
205      push @{$parent_node->{$tname}}, $node
206  } else {
207      $parent_node->{$tname} = [ $node ];
208  }
209}
210
211sub empty_tag {
212   local ($parent_node, $tag) = @_;
213   local $node = new_node($parent_node, $tag, 'EMPTY');
214   add_node($parent_node, $node);
215}
216
217sub open_tag {
218   local ($parent_node, $tag) = @_;
219   local $node;
220
221   if ($tag =~ /^\?.*/ || $tag =~ /^\!.*/) {
222      $node = new_node($parent_node, $tag, 'COMMENT');
223      add_node($parent_node, $node);
224      undef; return;
225   } else {
226      $node = new_node($parent_node, $tag, 'NODE');
227      $node->{CHILDREN} = [];
228      add_node($parent_node, $node);
229      return $node;
230   }
231}
232
233sub add_text_node {
234   local ($parent_node, $text) = @_;
235   local $node = new_node($parent_node, $text, 'TEXT');
236   add_node($parent_node, $node);
237}
238
239sub node_by_name {
240   local ($node, $name) = @_;
241   local ($tagname, $path) = split(/\//, $name, 2);
242
243   my @nodelist;
244
245   if ($tagname eq '') {
246      while ($node->{PARENT} != 0) {
247         $node = $node->{PARENT};
248      }
249      sublist_by_name($node, $path, \@nodelist);
250   } else {
251      sublist_by_name($node, $name, \@nodelist);
252   }
253   return @nodelist;
254}
255
256sub sublist_by_name {
257   local ($node, $name, $res) = @_;
258   local ($tagname, $path) = split(/\//, $name, 2);
259
260   if (! defined $path) {
261       push @{$res}, (@{$node->{$tagname}});
262       return;
263   }
264
265   if ($tagname eq '..' && $node->{PARENT} != 0) {
266      $node = $node->{PARENT};
267      sublist_by_name($node, $path, $res);
268   } else {
269      local $n;
270      for $n (@{$node->{$tagname}}) {
271         sublist_by_name($n, $path, $res);
272      }
273   }
274}
275
276sub node_attribute {
277    local $node = @_[0];
278    if (defined $node->{ATTRIBUTES}) {
279       return $node->{ATTRIBUTES}{@_[1]};
280    }
281    undef;
282}
283
284sub text_child {
285    local ($node) = @_;
286    local ($child) = node_by_name($node, 'TEXT');
287    return $child->{TEXT};
288}
289