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 ) = @_;
 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         $params[$idx] = "$paramValue";
 117         dumpXkbSettings ( @params );
 118         setXkbSettings ( @params );
 119         #print "--- dump:\n";
 120         #dumpXkbSettings( getXkbSettings() );
 121       }
 122
 123       open ( XSLTPROC2, "xsltproc --stringparam type $subtype --stringparam parentId $paramValue listCI2.xsl ../rules/base.xml.in |" ) or
 124         die ( "Could not start xsltproc" );
 125       while (<XSLTPROC2>)
 126       {
 127         chomp();
 128         if (/(\S+)/)
 129         {
 130           my $paramValue2=$1;
 131           print "  --- $subtype: [$paramValue2]\n";
 132           my @params = defaultXkbSettings();
 133           if ( $ifAddLevel1 )
 134           {
 135             $params[$idx] = "$paramValue$delim1$paramValue2$delim2";
 136           }
 137           else
 138           {
 139             $params[$idx] = "$paramValue2";
 140           }
 141           dumpXkbSettings ( @params );
 142           setXkbSettings ( @params );
 143           #print "--- dump:\n";
 144           #dumpXkbSettings( getXkbSettings() );
 145         }
 146       }
 147       close XSLTPROC2;
 148     }
 149   }
 150   close XSLTPROC;
 151 }
 152
 153 1;
 154 __END__
 155
 156 No docs yet