trying to test layouts as well
[xorg/xkeyboard-config] / tests / testModels.pl
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       open ( XSLTPROC2, "xsltproc --stringparam type $subtype --stringparam parentId $paramValue listCI2.xsl ../rules/base.xml.in |" ) or
105         die ( "Could not start xsltproc" );
106       while (<XSLTPROC2>)
107       {
108         chomp();
109         if (/(\S+)/)
110         {
111           my $paramValue2=$1;
112           print "  --- $subtype: [$paramValue2]\n";
113           my @params = defaultXkbSettings();
114           @params[$idx] = "$paramValue$delim1$paramValue2$delim2";
115           dumpXkbSettings ( @params );
116           setXkbSettings ( @params );
117           #print "--- dump:\n";
118           #dumpXkbSettings( getXkbSettings() );
119         }
120       }
121       close XSLTPROa2C;
122     }
123   }
124   close XSLTPROC;
125 }
126
127 backupXkbSettings();
128
129 dumpXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions );
130
131 #testLevel1( "model", 1 );
132 testLevel2( "layout", "variant", 2, "(", ")" );
133
134 restoreXkbSettings();