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 < filename.xml > filename.lst
   8 #
   9 # author Ivan Pascal
  10
  11 $doc = new_document( 0, '');
  12 parse('', $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
  19 print "! model\n";
  20 for $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
  26 print "\n! layout\n";
  27 for $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
  33 print "\n! variant\n";
  34 for $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
  45 print "\n! option\n";
  46 for $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
  60 sub 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
  84 sub 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
 135 sub new_document {
 136    $doc = new_node( 0, '', 'DOCUMENT');
 137    $doc->{CHILDREN} = [];
 138    return $doc;
 139 }
 140
 141 sub 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
 173 sub 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
 185 sub empty_tag {
 186    local ($parent_node, $tag) = @_;
 187    local $node = new_node($parent_node, $tag, 'EMPTY');
 188    add_node($parent_node, $node);
 189 }
 190
 191 sub 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
 207 sub 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
 213 sub 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
 230 sub 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
 250 sub node_attribute {
 251     local $node = @_[0];
 252     if (defined $node->{ATTRIBUTES}) {
 253        return $node->{ATTRIBUTES}{@_[1]};
 254     }
 255     undef;
 256 }
 257
 258 sub text_child {
 259     local ($node) = @_;
 260     local ($child) = node_by_name($node, 'TEXT');
 261     return $child->{TEXT};
 262 }