git.oblomov.eu Git - xorg/xkeyboard-config/blob - tests/xkbTestFunc.pm

   1 #!/bin/env perl
   2
   3 use strict;
   4
   5 my $origXkbRules;
   6 my $origXkbModel;
   7 my $origXkbLayouts;
   8 my $origXkbOptions;
   9 my $origXkbVariants;
  10
  11 sub backupXkbSettings
  12 {
  13   ( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ) = getXkbSettings();
  14 }
  15
  16 sub getXkbSettings
  17 {
  18   my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions );
  19
  20   open (XPROP, "xprop -root |") or die "Could not start xprop";
  21   PROP: while (<XPROP>)
  22   {
  23     if (/_XKB_RULES_NAMES\(STRING\) = \"(.*)\", \"(.*)\", \"(.*)\", \"(.*)\", \"(.*)\"/)
  24     {
  25       ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) =
  26       ( $1, $2, $3, $4, $5 ) ;
  27       last PROP;
  28     }
  29   }
  30   close XPROP;
  31
  32   return ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions );
  33 }
  34
  35 sub setXkbSettings
  36 {
  37   my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = @_;
  38   ( system ( "setxkbmap", "-synch",
  39        "-rules", $xkbRules,
  40        "-model", $xkbModel,
  41        "-layout", $xkbLayouts,
  42        "-variant", $xkbVariants,
  43        "-option", $xkbOptions ) == 0 ) or die "Could not set xkb configuration";
  44 }
  45
  46 sub restoreXkbSettings
  47 {
  48   setXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions );
  49 }
  50
  51 sub defaultXkbSettings
  52 {
  53   return ( "base", "pc105", "us", "", "" );
  54 }
  55
  56 sub dumpXkbSettings
  57 {
  58   my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = @_;
  59   print "rules: [$xkbRules]\n" ;
  60   print "model: [$xkbModel]\n" ;
  61   print "layouts: [$xkbLayouts]\n" ;
  62   print "variants: [$xkbVariants]\n" ;
  63   print "options: [$xkbOptions]\n" ;
  64 }
  65
  66 sub testLevel1
  67 {
  68   my ( $type, $idx ) = @_;
  69
  70   open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or
  71     die ( "Could not start xsltproc" );
  72   while (<XSLTPROC>)
  73   {
  74     chomp();
  75     if (/(\S+)/)
  76     {
  77       my $paramValue=$1;
  78       print "--- setting $type: [$paramValue]\n";
  79       my @params = defaultXkbSettings();
  80       @params[$idx] = $paramValue;
  81       dumpXkbSettings ( @params );
  82       setXkbSettings ( @params );
  83       #print "--- dump:\n";
  84       #dumpXkbSettings( getXkbSettings() );
  85     }
  86   }
  87   close XSLTPROC;
  88 }
  89
  90 sub testLevel2
  91 {
  92   my ( $type, $subtype, $idx, $delim1, $delim2 ) = @_;
  93
  94   open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or
  95     die ( "Could not start xsltproc" );
  96   while (<XSLTPROC>)
  97   {
  98     chomp();
  99     if (/(\S+)/)
 100     {
 101       my $paramValue=$1;
 102       print "--- scanning $type: [$paramValue]\n";
 103
 104       my @params = defaultXkbSettings();
 105       @params[$idx] = "$paramValue";
 106       dumpXkbSettings ( @params );
 107       setXkbSettings ( @params );
 108       #print "--- dump:\n";
 109       #dumpXkbSettings( getXkbSettings() );
 110
 111       open ( XSLTPROC2, "xsltproc --stringparam type $subtype --stringparam parentId $paramValue listCI2.xsl ../rules/base.xml.in |" ) or
 112         die ( "Could not start xsltproc" );
 113       while (<XSLTPROC2>)
 114       {
 115         chomp();
 116         if (/(\S+)/)
 117         {
 118           my $paramValue2=$1;
 119           print "  --- $subtype: [$paramValue2]\n";
 120           my @params = defaultXkbSettings();
 121           @params[$idx] = "$paramValue$delim1$paramValue2$delim2";
 122           dumpXkbSettings ( @params );
 123           setXkbSettings ( @params );
 124           #print "--- dump:\n";
 125           #dumpXkbSettings( getXkbSettings() );
 126         }
 127       }
 128       close XSLTPROa2C;
 129     }
 130   }
 131   close XSLTPROC;
 132 }
 133
 134 backupXkbSettings();
 135
 136 dumpXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions );
 137
 138 #testLevel1( "model", 1 );
 139 testLevel2( "layout", "variant", 2, "(", ")" );
 140
 141 restoreXkbSettings();