/[gentoo-src]/ufed/ufed.pl
Gentoo

Contents of /ufed/ufed.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.47 - (show annotations) (download) (as text)
Wed Apr 26 09:29:54 2006 UTC (7 years, 11 months ago) by truedfx
Branch: MAIN
CVS Tags: HEAD
Changes since 1.46: +12 -3 lines
File MIME type: text/x-perl
source support, and don't too much during BEGIN

1 #!/usr/bin/perl -I/usr/lib/ufed
2 use strict;
3 use warnings;
4
5 # Copyright 1999-2005 Gentoo Foundation
6 # Distributed under the terms of the GNU General Public License v2
7 # $Header: /var/cvsroot/gentoo-src/ufed/ufed.pl,v 1.46 2006/04/25 12:51:07 truedfx Exp $
8
9 use Portage;
10
11 my $version = '0.40';
12
13 my %use_descriptions;
14
15 sub finalise(@);
16 sub flags_dialog();
17 sub read_use_descs();
18 sub save_flags(@);
19
20 delete $Portage::all_flags{'*'};
21
22 read_use_descs;
23
24 delete @use_descriptions{qw(bootstrap build)};
25
26 $Portage::all_flags{'-*'} = 1 if defined $Portage::make_conf_flags{'*'} && !$Portage::make_conf_flags{'*'};
27
28 Portage::merge %Portage::use_masked_flags, %Portage::archs;
29
30 for(keys %Portage::all_flags) {
31 @{$use_descriptions{$_}} = "(Unknown)"
32 if not exists $use_descriptions{$_};
33 }
34 @{$use_descriptions{'-*'}} = 'Never enable any flags other than those specified in /etc/make.conf';
35
36 for(keys %Portage::use_masked_flags)
37 { delete $use_descriptions{$_} if $Portage::use_masked_flags{$_} }
38
39 flags_dialog;
40
41 sub finalise(@) {
42 my %flags;
43 @flags{@_} = ();
44 if(exists $flags{'-*'}) {
45 return sort keys %flags;
46 } else {
47 my(@enabled, @disabled);
48 my %all_flags;
49 @all_flags{keys %flags, keys %Portage::default_flags} = ();
50 for(sort keys %all_flags) {
51 next if $_ eq '*';
52 push @enabled, $_ if exists $flags{$_} && !$Portage::default_flags{$_};
53 push @disabled, "-$_" if $Portage::default_flags{$_} && !exists $flags{$_};
54 }
55 return @enabled, @disabled;
56 }
57 }
58
59 sub flags_dialog() {
60 use POSIX ();
61 POSIX::dup2 1, 3;
62 POSIX::dup2 1, 4;
63 my ($iread, $iwrite) = POSIX::pipe;
64 my ($oread, $owrite) = POSIX::pipe;
65 my $child = fork;
66 die "fork() failed\n" if not defined $child;
67 if($child == 0) {
68 POSIX::close $iwrite;
69 POSIX::close $oread;
70 POSIX::dup2 $iread, 3;
71 POSIX::close $iread;
72 POSIX::dup2 $owrite, 4;
73 POSIX::close $owrite;
74 my $interface = 'ufed-curses';
75 exec { "./$interface" } $interface or
76 exec { "/usr/lib/ufed/$interface" } $interface or
77 do { print STDERR "Couldn't launch $interface\n"; exit 3 }
78 }
79 POSIX::close $iread;
80 POSIX::close $owrite;
81 if(open my $fh, '>&=', $iwrite) {
82 my @flags = sort { uc $a cmp uc $b } keys %use_descriptions;
83 my %descriptions;
84 for(my $flag=0; $flag<@flags; $flag++) {
85 my $flag = $flags[$flag];
86 print $fh $flag, $Portage::all_flags{$flag} ? ' on ' : ' off ';
87 print $fh exists $Portage::make_defaults_flags{$flag} ? $Portage::make_defaults_flags{$flag} ? '(+' :'(-' :'( ' ;
88 print $fh exists $Portage::use_defaults_flags{$flag} ? $Portage::use_defaults_flags{$flag} ? '+' : '-' : ' ' ;
89 print $fh exists $Portage::make_conf_flags{$flag} ? $Portage::make_conf_flags{$flag} ? '+)': '-)': ' )';
90 print $fh ' ', scalar(@{$use_descriptions{$flag}}), "\n";
91 print $fh $_, "\n" for(@{$use_descriptions{$flag}});
92 }
93 close $fh;
94 } else {
95 die "Couldn't let interface know of flags\n";
96 }
97 POSIX::close $iwrite;
98 wait;
99 open my $fh, '<&=', $oread or die "Couldn't read output.\n";
100 if(POSIX::WIFEXITED($?)) {
101 my $rc = POSIX::WEXITSTATUS($?);
102 if($rc==0) {
103 my @flags = do { local $/; split /\n/, <$fh> };
104 save_flags finalise sort @flags;
105 } elsif($rc==1)
106 { print "Cancelled, not saving changes.\n" }
107 exit $rc;
108 } elsif(POSIX::WIFSIGNALED($?))
109 { kill POSIX::WTERMSIG($?), $$ }
110 else
111 { exit 127 }
112 }
113
114 sub read_use_descs() {
115 my %_use_descriptions;
116 for my $dir(@Portage::portagedirs) {
117 for(Portage::noncomments "$dir/profiles/use.desc") {
118 my ($flag, $desc) = /^(.*?)\s+-\s+(.*)$/ or next;
119 $_use_descriptions{$flag}{$desc} = 1;
120 }
121 for my $var (@Portage::use_expand) {
122 for(Portage::noncomments "$dir/profiles/desc/$var.desc") {
123 my ($flag, $desc) = /^(.*?)\s+-\s+(.*)$/ or next;
124 $_use_descriptions{"${var}_${flag}"}{$desc} = 1;
125 }
126 }
127 }
128 my %_use_local_descriptions;
129 for my $dir(@Portage::portagedirs) {
130 for(Portage::noncomments "$dir/profiles/use.local.desc") {
131 my ($pkg, $flag, $desc) = /^(.*?):(.*?)\s+-\s+(.*)$/ or next;
132 $_use_local_descriptions{$flag}{$desc}{$pkg} = 1;
133 }
134 }
135 local $"=", ";
136 for(sort keys %_use_descriptions)
137 { @{$use_descriptions{$_}} = sort keys %{$_use_descriptions{$_}} }
138 for(sort keys %_use_local_descriptions) {
139 for my $desc(sort keys %{$_use_local_descriptions{$_}})
140 { push @{$use_descriptions{$_}}, "Local flag: $desc (@{[sort keys %{$_use_local_descriptions{$_}{$desc}}]})" }
141 }
142 }
143
144 sub save_flags(@) {
145 my $BLANK = qr{(?:[ \n\t]+|#.*)+}; # whitespace and comments
146 my $UBLNK = qr{(?: # as above, but scan for #USE=
147 [ \n\t]+ |
148 \#[ \t]*USE[ \t]*=.*(\n?) | # place capture after USE=... line
149 \#.*)+}x;
150 my $IDENT = qr{([^ \\\n\t'"{}=]+)}; # identifiers
151 my $ASSIG = qr{=}; # assignment operator
152 my $UQVAL = qr{(?:[^ \\\n\t'"]+|\\.)+}s; # unquoted value
153 my $SQVAL = qr{'[^']*'}; # singlequoted value
154 my $DQVAL = qr{"(?:[^\\"]|\\.)*"}s; # doublequoted value
155 my $BNUQV = qr{(?:[^ \\\n\t'"]+|\\\n()|\\.)+}s; # unquoted value (scan for \\\n)
156 my $BNDQV = qr{"(?:[^\\"]|\\\n()|\\.)*"}s; # doublequoted value (scan for \\\n)
157
158 my %flags;
159 $flags{'USE'} = [];
160 FLAG: for my $flag(@_) {
161 for my $var(keys %{$Portage::environment{USE_EXPAND}}) {
162 my $lcvar = lc $var;
163 if($flag =~ s/^\Q${lcvar}_//) {
164 push @{$flags{$var}}, $flag;
165 next FLAG;
166 }
167 }
168 push @{$flags{USE}}, $flag;
169 }
170
171 my $contents;
172
173 {
174 open my $makeconf, '<', '/etc/make.conf' or die "Couldn't open /etc/make.conf\n";
175 open my $makeconfold, '>', '/etc/make.conf.old' or die "Couldn't open /etc/make.conf.old\n";
176 local $/;
177 $_ = <$makeconf>;
178 print $makeconfold $_;
179 close $makeconfold;
180 close $makeconf;
181 }
182
183 my $sourcing = 0;
184 eval {
185 # USE comment start/end (start/end of newline character at the end, specifically)
186 # default to end of make.conf, to handle make.confs without #USE=
187 my($ucs, $uce) = (length, length);
188 pos = 0;
189 for(;;) {
190 if(/\G$UBLNK/gc) {
191 ($ucs, $uce) = ($-[1], $+[1]) if defined $1;
192 }
193 last if pos == length;
194 my $linestart;
195 my $flagatstartofline = do {
196 $linestart = 1+rindex $_, "\n", pos()-1;
197 my $line = substr($_, $linestart, pos()-$linestart);
198 $line !~ /[^ \t]/;
199 };
200 my $start = pos;
201 /\G$IDENT/gc or die;
202 my $name = $1;
203 /\G$BLANK/gc;
204 if($name ne 'source') {
205 /\G$ASSIG/gc or die;
206 /\G$BLANK/gc;
207 } else {
208 $sourcing = 1;
209 }
210 die if pos == length;
211 my $valstart = pos;
212 /\G(?:$BNUQV|$SQVAL|$BNDQV)+/gc or die;
213 my $end = pos;
214
215 if(not defined $flags{$name}) {
216 if($name eq 'USE' or defined $Portage::environment{USE_EXPAND}{$name}) {
217 # If we get here, we already found this var earlier in make.conf
218 # so now we just remove it
219 if($flagatstartofline) {
220 /\n/gc;
221 substr($_, $linestart, pos()-$linestart) = '';
222 pos = $linestart;
223 } else {
224 substr($_, $start, $end-$start) = '';
225 pos = $start;
226 }
227 }
228 next;
229 }
230
231 # save whether user uses backslash-newline
232 my $bsnl = defined $1 || defined $2;
233 # start of the line is one past the last newline; also handles first line
234 $linestart = 1+rindex $_, "\n", $valstart-1;
235 # everything on the current line before the flags, plus one for the "
236 my $line = substr($_, $linestart, $valstart-$linestart).' ';
237 # only indent if the var starts a line
238 my $blank = $flagatstartofline ? $line : "";
239 $blank =~ s/[^ \t]/ /g;
240 # word wrap
241 my $flags = '';
242 if(@{$flags{$name}} != 0) {
243 my $length = 0;
244 while($line =~ /(.)/g) {
245 if($1 ne "\t") {
246 $length++;
247 } else {
248 # no best tab size discussions, please. terminals use ts=8.
249 $length&=~8;
250 $length+=8;
251 }
252 }
253 my $blanklength = $blank ne '' ? $length : 0;
254 # new line, using backslash-newline if the user did that
255 my $nl = ($bsnl ? " \\\n" : "\n").$blank;
256 my $linelength = $bsnl ? 76 : 78;
257 my $flag = $flags{$name}[0];
258 if($blanklength != 0 || length $flag <= $linelength) {
259 $flags = $flag;
260 $length += length $flag;
261 } else {
262 $flags = $nl.$flag;
263 $length = length $flag;
264 }
265 for $flag(@{$flags{$name}}[1..$#{$flags{$name}}]) {
266 if($length + 1 + length $flag <= $linelength) {
267 $flags .= " $flag";
268 $length += 1+length $flag;
269 } else {
270 $flags .= $nl.$flag;
271 $length = $blanklength + length $flag;
272 }
273 }
274 }
275 # replace the current flags with the modified ones
276 substr($_, $valstart, $end-$valstart) = "\"$flags\"";
277 # and have the next search start after our new flags
278 pos = $valstart + 2 + length $flags;
279 # now don't set this var again
280 delete $flags{$name};
281 }
282 for my $var (reverse sort keys %flags) {
283 # if we didn't replace all the flags yet, tack the rest
284 # after the last #USE= or at the end
285 my $flags = '';
286 if(@{$flags{$var}} != 0) {
287 $flags = $flags{$var}[0];
288 my $length = length($var) + 2 + length $flags;
289 for my $flag(@{$flags{$var}}[1..$#{$flags{$var}}]) {
290 if($length + 1 + length $flag <= 78) {
291 $flags .= " $flag";
292 $length += 1+length $flag;
293 } else {
294 $flags .= "\n $flag";
295 $length = length($var) + 2 + length $flag;
296 }
297 }
298 }
299 substr($_, $ucs, $uce-$ucs) = "\n$var=\"$flags\"\n";
300 }
301 };
302 die "Parse error when writing make.conf - did you modify it while ufed was running?\n" if $@;
303
304 print STDERR <<EOF if $sourcing;
305 Warning: source command found in /etc/make.conf. Flags may
306 be saved incorrectly if the sourced file modifies them.
307 EOF
308 {
309 open my $makeconf, '>', '/etc/make.conf' or die "Couldn't open /etc/make.conf\n";
310 print $makeconf $_;
311 close $makeconf;
312 }
313 }

  ViewVC Help
Powered by ViewVC 1.1.20