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   ( system ( "setxkbmap", "-synch",
  42        "-rules", $xkbRules,
  43        "-model", $xkbModel,
  44        "-layout", $xkbLayouts,
  45        "-variant", $xkbVariants,
  46        "-option", $xkbOptions ) == 0 ) or die "Could not set xkb configuration";
  47   sleep 1;
  48 }
  49
  50 sub restoreXkbSettings
  51 {
  52   setXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions );
  53 }
  54
  55 sub defaultXkbSettings
  56 {
  57   return ( "base", "pc105", "us", "", "" );
  58 }
  59
  60 sub dumpXkbSettings
  61 {
  62   my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = @_;
  63   print "rules: [$xkbRules]\n" ;
  64   print "model: [$xkbModel]\n" ;
  65   print "layouts: [$xkbLayouts]\n" ;
  66   print "variants: [$xkbVariants]\n" ;
  67   print "options: [$xkbOptions]\n" ;
  68 }
  69
  70 sub dumpXkbSettingsBackup
  71 {
  72   dumpXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions );
  73 }
  74
  75 sub testLevel1
  76 {
  77   my ( $type, $idx ) = @_;
  78
  79   open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or
  80     die ( "Could not start xsltproc" );
  81   while (<XSLTPROC>)
  82   {
  83     chomp();
  84     if (/(\S+)/)
  85     {
  86       my $paramValue=$1;
  87       print "--- setting $type: [$paramValue]\n";
  88       my @params = defaultXkbSettings();
  89       $params[$idx] = $paramValue;
  90       dumpXkbSettings ( @params );
  91       setXkbSettings ( @params );
  92       #print "--- dump:\n";
  93       #dumpXkbSettings( getXkbSettings() );
  94     }
  95   }
  96   close XSLTPROC;
  97 }
  98
  99 sub testLevel2
 100 {
 101   my ( $type, $subtype, $idx, $delim1, $delim2, $ifCheckLevel1, $ifAddLevel1, $ifResetToDefault ) = @_;
 102
 103   open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or
 104     die ( "Could not start xsltproc" );
 105   while (<XSLTPROC>)
 106   {
 107     chomp();
 108     if (/(\S+)/)
 109     {
 110       my $paramValue=$1;
 111       print "--- scanning $type: [$paramValue]\n";
 112
 113       if ( $ifCheckLevel1 )
 114       {
 115         my @params = defaultXkbSettings();
 116         if ( $ifResetToDefault )
 117         {
 118           setXkbSettings ( @params );
 119         }
 120         $params[$idx] = "$paramValue";
 121         dumpXkbSettings ( @params );
 122         setXkbSettings ( @params );
 123         #print "--- dump:\n";
 124         #dumpXkbSettings( getXkbSettings() );
 125       }
 126
 127       open ( XSLTPROC2, "xsltproc --stringparam type $subtype --stringparam parentId $paramValue listCI2.xsl ../rules/base.xml.in |" ) or
 128         die ( "Could not start xsltproc" );
 129       while (<XSLTPROC2>)
 130       {
 131         chomp();
 132         if (/(\S+)/)
 133         {
 134           my $paramValue2=$1;
 135           print "  --- $subtype: [$paramValue2]\n";
 136           my @params = defaultXkbSettings();
 137           if ( $ifResetToDefault )
 138           {
 139             setXkbSettings ( @params );
 140           }
 141           if ( $ifAddLevel1 )
 142           {
 143             $params[$idx] = "$paramValue$delim1$paramValue2$delim2";
 144           }
 145           else
 146           {
 147             $params[$idx] = "$paramValue2";
 148           }
 149           dumpXkbSettings ( @params );
 150           setXkbSettings ( @params );
 151           #print "--- dump:\n";
 152           #dumpXkbSettings( getXkbSettings() );
 153         }
 154       }
 155       close XSLTPROC2;
 156     }
 157   }
 158   close XSLTPROC;
 159 }
 160
 161 1;
 162 __END__
 163
 164 No docs yet