git.oblomov.eu Git - xorg/xkeyboard-config/blob - rules/xml2lst.pl

   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
  11 if (@ARGV) {
  12    $lang = shift @ARGV;
  13 } else {
  14    $lang = '';
  15 }
  16
  17 $doc = new_document( 0, '');
  18 parse('', $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
  25 print "! model\n";
  26 for $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
  36 print "\n! layout\n";
  37 for $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
  47 print "\n! variant\n";
  48 for $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
  63 print "\n! option\n";
  64 for $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
  86 sub 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
 110 sub 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
 161 sub new_document {
 162    $doc = new_node( 0, '', 'DOCUMENT');
 163    $doc->{CHILDREN} = [];
 164    return $doc;
 165 }
 166
 167 sub 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
 199 sub 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
 211 sub empty_tag {
 212    local ($parent_node, $tag) = @_;
 213    local $node = new_node($parent_node, $tag, 'EMPTY');
 214    add_node($parent_node, $node);
 215 }
 216
 217 sub 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
 233 sub 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
 239 sub 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
 256 sub 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
 276 sub node_attribute {
 277     local $node = @_[0];
 278     if (defined $node->{ATTRIBUTES}) {
 279        return $node->{ATTRIBUTES}{@_[1]};
 280     }
 281     undef;
 282 }
 283
 284 sub text_child {
 285     local ($node) = @_;
 286     local ($child) = node_by_name($node, 'TEXT');
 287     return $child->{TEXT};
 288 }