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

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