summaryrefslogtreecommitdiffstats
path: root/lib/Xconfig/plugins.pm
blob: 635766fd4f44818e6d834ec0f807e42d294216ee (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
package Xconfig::plugins; # $Id: plugins.pm 110085 2007-01-18 08:45:14Z pixel $

use diagnostics;
use strict;

use Xconfig::parse;
use Xconfig::xfree;
use lib qw(/usr/lib/libDrakX); # for perl_checker
use common;
# perl_checker: require MDK::Common

my $dir = '/usr/share/libDrakX/x11-plugins';

sub list() {
    glob_("$dir/*.pl");
}

sub _load {
    my ($plugin_pl_file) = @_;
    my $plugin = eval cat_($plugin_pl_file);
    $@ and die "bad $plugin_pl_file. error: $@\n";

    #- ensure only one line
    $plugin->{summary} =~ s/\n/ /g;

    eval { $plugin->{raw} = Xconfig::parse::read_XF86Config_from_string($plugin->{conf}) };
    $@ and die "bad $plugin_pl_file conf. error: $@\n";

    $plugin;
}

my $mark = '# Using plugin';
sub parse_active_plugin {
    my ($raw_X) = @_;

    $raw_X->{plugins} and internal_error("parse_active_plugin must be done before doing anything with plugins");

    my $first = $raw_X->{raw}[0];
    if (my @l = $first->{pre_comment} =~ /^\Q$mark\E (.*)/gm) {
	$raw_X->{plugins} = [ map { { active => 1, summary => $_ } } @l ];
    }
}
sub _mark_active_in_header {
    my ($raw_X, $summary) = @_;
    my $first = $raw_X->{raw}[0];
    $first->{pre_comment} =~ s/\n/\n$mark $summary\n/;
}
sub _remove_active_in_header {
    my ($raw_X, $summary) = @_;
    my $first = $raw_X->{raw}[0];
    $first->{pre_comment} =~ s/\Q$mark $summary\E\n//;
}

sub load {
    my ($raw_X, $plugin_pl_file) = @_;

    my $plugin = eval { _load($plugin_pl_file) };
    $@ and log::l("bad plugin $plugin_pl_file: $@"), return;

    if (my $existing = find { $_->{summary} eq $plugin->{summary} } @{$raw_X->{plugins}}) {
	put_in_hash($existing, $plugin);
	$existing->{updated} = 1;
    } else {
	push @{$raw_X->{plugins}}, $plugin;	
    }
}

sub val { &Xconfig::xfree::val }

sub apply_plugin {
    my ($raw_X, $plugin) = @_;

    if ($plugin->{active}) {
	$plugin->{updated} or return;

	#- removing before re-applying again
	remove_plugin($raw_X, $plugin);
    }

    log::l("applying plugin $plugin->{summary}");

    foreach my $e (@{$plugin->{raw}}) {
	_mark_lines_with_name($plugin->{summary}, $e);

	if (my @sections = _select_sections_to_modify($raw_X, $e)) {
	    #- modifying existing sections
	    #- if there is more than one, modify all of them!
	    _merge_in_section($_, $e->{l}) foreach @sections;
	} else {
	    #- adding the section
	    $raw_X->add_Section($e->{name}, $e->{l});
	}
    }

    _mark_active_in_header($raw_X, $plugin->{summary});
    $plugin->{active} = 1;
}

sub _select_sections_to_modify {
    my ($raw_X, $e) = @_;

    my @sections = $raw_X->get_Sections($e->{name}) or return;

    if ($e->{l}{Identifier}) {
	if (my @l = grep { val($_->{Identifier}) eq $e->{l}{Identifier}{val} } @sections) {
	    #- only modifying the section(s) matching the Driver (useful for InputDevice)
	    delete $e->{l}{Identifier}; #- do not tag-with-comment this line used only to select the section
	    @l;
	} else {
	    #- if no matching section, we will create it
	    ();
	}
    } elsif ($e->{l}{Driver}) {
	if (my @l = grep { val($_->{Driver}) eq $e->{l}{Driver}{val} } @sections) {
	    #- only modifying the section(s) matching the Driver (useful for InputDevice)
	    delete $e->{l}{Driver}; #- do not tag-with-comment this line used only to select the section
	    @l;
	} else {
	    #- hum, modifying existing sections, is that good? :-/
	    @sections;
	}
    } else {
	#- modifying existing sections
	@sections;
    }
}

sub _merge_in_section {
    my ($h, $h_to_add) = @_;

    foreach my $name (keys %$h_to_add) {
	if (exists $h->{$name}) {
	    my $pre_comment = join('', map { "#HIDDEN $_->{val}\n" } deref_array($h->{$name}));
	    my ($first, @other) = deref_array($h_to_add->{$name});
	    $first = { pre_comment => $pre_comment, %$first };

	    $h->{$name} = ref($h->{$name}) eq 'ARRAY' ? [ $first, @other ] : $first;
	} else {
	    $h->{$name} = $h_to_add->{$name};
	}
    }
}

sub _mark_lines_with_name {
    my ($summary, $e) = @_;
    if ($e->{l}) {
	_mark_lines_with_name($summary, $_) foreach map { deref_array($_) } values %{$e->{l}};
    } else {
	$e->{comment_on_line} = " # $summary";
    }
}

sub remove_plugin {
    my ($raw_X, $plugin) = @_;

    $plugin->{active} or return;

    log::l("removing plugin $plugin->{summary}");

    @{$raw_X->{raw}} = map {
	_remove_plugin($plugin->{summary}, $_);
    } @{$raw_X->{raw}};

    _remove_active_in_header($raw_X, $plugin->{summary});
    $plugin->{active} = 0;
}

sub _remove_plugin {
    my ($summary, $e) = @_;
    if ($e->{l}) {
	my $removed;
	foreach my $k (keys %{$e->{l}}) {
	    my $v = $e->{l}{$k};
	    my @v = map { _remove_plugin($summary, $_) } deref_array($v);
	    if (@v) {
		if (ref($v) eq 'ARRAY') {
		    @$v = @v;
		} else {
		    $e->{l}{$k} = $v[0];
		}
	    } else {
		$removed = 1;
		delete $e->{l}{$k};
	    }
	}
	if_(!$removed || %{$e->{l}}, $e);
    } elsif ($e->{comment_on_line} eq " # $summary") {
	if (my @hidden = $e->{pre_comment} =~ /^#HIDDEN (.*)/gm) {
	    delete $e->{comment_on_line};
	    delete $e->{pre_comment};
	    map { { %$e, val => $_ } } @hidden;
	} else {
	    ();
	}
    } else {
	$e;
    }
}

sub apply_or_remove_plugin {
    my ($raw_X, $plugin, $apply) = @_;

    if ($apply) {
	apply_plugin($raw_X, $plugin);
    } else {
	remove_plugin($raw_X, $plugin);
    }
}

sub choose {
    my ($in, $raw_X) = @_;    

    parse_active_plugin($raw_X) if !$raw_X->{plugins};

    load($raw_X, $_) foreach list();

    my $plugins = $raw_X->{plugins};
    $_->{want_active} = $_->{active} foreach @$plugins;

    $in->ask_from_({},
		  [ { title => 1, label => N("Choose plugins") },
		    map { 
		      { type => 'bool', val => \$_->{want_active}, text => $_->{summary} },
			{ val => formatAlaTeX($_->{description}) };
		  } @$plugins ]) or return;

    foreach (@$plugins) {
	apply_or_remove_plugin($raw_X, $_, $_->{want_active})
	  if $_->{want_active} != $_->{active};
    }

    1;
}
1;