1 |
package Xconfig::parse; # $Id: parse.pm 247269 2008-10-01 13:57:30Z pixel $ |
2 |
|
3 |
use diagnostics; |
4 |
use strict; |
5 |
|
6 |
use common; |
7 |
|
8 |
|
9 |
sub read_XF86Config { |
10 |
my ($file) = @_; |
11 |
my $raw = _rraw_from_file($file); |
12 |
_from_rraw(@$raw); |
13 |
$raw; |
14 |
} |
15 |
|
16 |
sub prepare_write_XF86Config { |
17 |
my ($raw) = @_; |
18 |
map { _raw_to_string(_before_to_string({ %$_ }, 0)) } @$raw; |
19 |
} |
20 |
|
21 |
sub write_XF86Config { |
22 |
my ($raw, $file) = @_; |
23 |
my @blocks = prepare_write_XF86Config($raw); |
24 |
@blocks ? output($file, @blocks) : unlink $file; |
25 |
} |
26 |
|
27 |
sub read_XF86Config_from_string { |
28 |
my ($s) = @_; |
29 |
my $raw = _rraw_from_file('-', [ split "\n", $s ]); |
30 |
_from_rraw(@$raw); |
31 |
$raw; |
32 |
} |
33 |
|
34 |
#-############################################################################### |
35 |
#- raw reading/saving |
36 |
#-############################################################################### |
37 |
sub _rraw_from_file { |
38 |
my ($file, $o_lines) = @_; |
39 |
my $rraw = []; |
40 |
|
41 |
my $lines = $o_lines || [ cat_($file) ]; |
42 |
my $line; |
43 |
|
44 |
my ($comment, $obj, @objs); |
45 |
|
46 |
my $attach_comment = sub { |
47 |
$obj || @objs or warn "$file:$line: can not attach comment\n"; |
48 |
if ($comment) { |
49 |
$comment =~ s/\n+$/\n/; |
50 |
($obj || $objs[0])->{$_[0] . '_comment'} = $comment; |
51 |
$comment = ''; |
52 |
} |
53 |
}; |
54 |
|
55 |
foreach (@$lines) { |
56 |
$line++; |
57 |
s/^\s*//; s/\s*$//; |
58 |
|
59 |
if (/^$/) { |
60 |
$comment .= "\n" if $comment; |
61 |
next; |
62 |
} elsif (@objs ? m/^#\W/ || /^#$/ : /^#/) { |
63 |
s/^#\s+/# /; |
64 |
$comment .= "$_\n"; |
65 |
next; |
66 |
} |
67 |
|
68 |
if (/^Section\s+"(.*)"/i) { |
69 |
die "$file:$line: missing EndSection\n" if @objs; |
70 |
my $e = { name => $1, l => [], kind => 'Section' }; |
71 |
push @$rraw, $e; |
72 |
unshift @objs, $e; $obj = ''; |
73 |
$attach_comment->('pre'); |
74 |
} elsif (/^Subsection\s+"(.*)"/i) { |
75 |
die "$file:$line: missing EndSubsection\n" if @objs && $objs[0]{kind} eq 'Subsection'; |
76 |
die "$file:$line: not in Section\n" if !@objs || $objs[0]{kind} ne 'Section'; |
77 |
my $e = { name => $1, l => [], kind => 'Subsection' }; |
78 |
push @{$objs[0]{l}}, $e; |
79 |
unshift @objs, $e; $obj = ''; |
80 |
$attach_comment->('pre'); |
81 |
} elsif (/^EndSection/i) { |
82 |
die "$file:$line: not in Section\n" if !@objs || $objs[0]{kind} ne 'Section'; |
83 |
$attach_comment->('post'); |
84 |
shift @objs; $obj = ''; |
85 |
} elsif (/^EndSubsection/i) { |
86 |
die "$file:$line: not in Subsection\n" if !@objs || $objs[0]{kind} ne 'Subsection'; |
87 |
$attach_comment->('post'); |
88 |
shift @objs; $obj = ''; |
89 |
} else { |
90 |
die "$file:$line: not in Section\n" if !@objs; |
91 |
|
92 |
my $commented = s/^#//; |
93 |
|
94 |
my $comment_on_line; |
95 |
s/(\s*#.*)/$comment_on_line = $1; ''/e; |
96 |
|
97 |
if (/^$/) { |
98 |
die "$file:$line: weird"; |
99 |
} |
100 |
|
101 |
(my $name, my $Option, $_) = |
102 |
/^Option\s*"(.*?)"(.*)/ ? ($1, 1, $2) : /^(\S+)(.*)/ ? ($1, 0, $2) : internal_error($_); |
103 |
my ($val) = /(\S.*)/; |
104 |
|
105 |
my %e = (Option => $Option, commented => $commented, comment_on_line => $comment_on_line, pre_comment => $comment); |
106 |
$comment = ''; |
107 |
$obj = { name => $name, val => $val }; |
108 |
$e{$_} and $obj->{$_} = $e{$_} foreach keys %e; |
109 |
|
110 |
push @{$objs[0]{l}}, $obj; |
111 |
} |
112 |
} |
113 |
$rraw; |
114 |
} |
115 |
|
116 |
sub _simple_val_to_string { |
117 |
my ($name, $e) = @_; |
118 |
my $key = $e->{Option} ? qq(Option "$name") : $name; |
119 |
my $val = defined $e->{val} ? ($e->{Option} && $e->{val} !~ /^"/ ? qq( "$e->{val}") : qq( $e->{val})) : ''; |
120 |
($e->{commented} ? '#' : '') . $key . $val; |
121 |
} |
122 |
|
123 |
sub _raw_to_string { |
124 |
my ($e, $b_want_spacing) = @_; |
125 |
my $s = do { |
126 |
if ($e->{l}) { |
127 |
my $inside = join('', map_index { _raw_to_string($_, $::i) } @{$e->{l}}); |
128 |
$inside .= $e->{post_comment} || ''; |
129 |
$inside =~ s/^/ /mg; |
130 |
qq(\n$e->{kind} "$e->{name}"\n) . $inside . "End$e->{kind}"; |
131 |
} else { |
132 |
_simple_val_to_string($e->{name}, $e); |
133 |
} |
134 |
}; |
135 |
($e->{pre_comment} ? ($b_want_spacing ? "\n" : '') . $e->{pre_comment} : '') . $s . ($e->{comment_on_line} || '') . "\n" . (!$e->{l} && $e->{post_comment} || ''); |
136 |
} |
137 |
|
138 |
#-############################################################################### |
139 |
#- refine the data structure for easier use |
140 |
#-############################################################################### |
141 |
my %kind_names = ( |
142 |
Pointer => [ qw(Protocol Device Emulate3Buttons Emulate3Timeout EmulateWheel EmulateWheelButton) ], |
143 |
Mouse => [ qw(DeviceName Protocol Device AlwaysCore Emulate3Buttons Emulate3Timeout EmulateWheel EmulateWheelButton) ], # Subsection in XInput |
144 |
Keyboard => [ qw(Protocol Driver XkbModel XkbLayout XkbDisable) ], |
145 |
Monitor => [ qw(Identifier VendorName ModelName HorizSync VertRefresh PreferredMode) ], |
146 |
Device => [ qw(Identifier VendorName BoardName Chipset Driver VideoRam Screen BusID DPMS power_saver AccelMethod MonitorLayout TwinViewOrientation BIOSHotkeys RenderAccel SWCursor XaaNoOffscreenPixmaps) ], |
147 |
Display => [ qw(Depth Modes Virtual) ], # Subsection in Device |
148 |
Screen => [ qw(Identifier Driver Device Monitor DefaultDepth DefaultColorDepth) ], |
149 |
Extensions => [ qw(Composite) ], |
150 |
InputDevice => [ qw(Identifier Driver Protocol Device Type Mode XkbModel XkbLayout XkbDisable Emulate3Buttons Emulate3Timeout EmulateWheel EmulateWheelButton) ], |
151 |
WacomCursor => [ qw(Port) ], #-\ |
152 |
WacomStylus => [ qw(Port) ], #--> Port must be first |
153 |
WacomEraser => [ qw(Port) ], #-/ |
154 |
ServerLayout => [ qw(Identifier) ], |
155 |
); |
156 |
my @want_string = qw(Identifier DeviceName VendorName ModelName BoardName Driver Device Chipset Monitor Protocol XkbModel XkbLayout XkbOptions XkbCompat Load Disable ModulePath BusID PreferredMode); |
157 |
|
158 |
%kind_names = map_each { lc $::a => [ map { lc } @$::b ] } %kind_names; |
159 |
@want_string = map { lc } @want_string; |
160 |
|
161 |
sub _from_rraw { |
162 |
sub _from_rraw__rec { |
163 |
my ($current, $e) = @_; |
164 |
if ($e->{l}) { |
165 |
_from_rraw($e); |
166 |
push @{$current->{l}{$e->{name}}}, $e; |
167 |
} else { |
168 |
if (member(lc $e->{name}, @want_string) || $e->{Option} && $e->{val}) { |
169 |
$e->{val} =~ s/^"(.*)"$/$1/ or warn "$e->{name} $e->{val} has no quote\n"; |
170 |
} |
171 |
|
172 |
if (member(lc $e->{name}, @{$kind_names{lc $current->{name}} || []})) { |
173 |
if ($current->{l}{$e->{name}} && !$current->{l}{$e->{name}}{commented}) { |
174 |
warn "skipping conflicting line for $e->{name} in $current->{name}\n" if !$e->{commented}; |
175 |
} else { |
176 |
$current->{l}{$e->{name}} = $e; |
177 |
} |
178 |
} else { |
179 |
push @{$current->{l}{$e->{name}}}, $e; |
180 |
} |
181 |
} |
182 |
delete $e->{name}; |
183 |
} |
184 |
|
185 |
foreach my $e (@_) { |
186 |
($e->{l}, my $l) = ({}, $e->{l}); |
187 |
_from_rraw__rec($e, $_) foreach @$l; |
188 |
|
189 |
delete $e->{kind}; |
190 |
} |
191 |
} |
192 |
|
193 |
sub _before_to_string { |
194 |
my ($e, $depth) = @_; |
195 |
|
196 |
if ($e->{l}) { |
197 |
$e->{kind} = $depth ? 'Subsection' : 'Section'; |
198 |
|
199 |
my %rated = map_index { $_ => $::i + 1 } @{$kind_names{lc $e->{name}} || []}; |
200 |
my @sorted = sort { ($rated{lc $a} || 99) <=> ($rated{lc $b} || 99) } keys %{$e->{l}}; |
201 |
$e->{l} = [ map { |
202 |
my $name = $_; |
203 |
map { |
204 |
_before_to_string({ name => $name, %$_ }, $depth+1); |
205 |
} deref_array($e->{l}{$name}); |
206 |
} @sorted ]; |
207 |
} elsif (member(lc $e->{name}, @want_string)) { |
208 |
$e->{val} = qq("$e->{val}"); |
209 |
} |
210 |
$e; |
211 |
} |