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