1package xkbTestFunc;
2
3use strict;
4use warnings;
5
6our $VERSION='1.00';
7
8our $origXkbRules;
9our $origXkbModel;
10our $origXkbLayouts;
11our $origXkbOptions;
12our $origXkbVariants;
13
14sub backupXkbSettings
15{
16  ( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ) = getXkbSettings();
17}
18
19sub 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
38sub 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
51sub restoreXkbSettings
52{
53  setXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions );
54}
55
56sub defaultXkbSettings
57{
58  return ( "base", "pc105", "us", "", "" );
59}
60
61sub 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
71sub dumpXkbSettingsBackup
72{
73  dumpXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions );
74}
75
76sub 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
100sub 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
1621;
163__END__
164
165No docs yet
166