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

Contents of /ufed/ufed.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.47 - (hide annotations) (download) (as text)
Wed Apr 26 09:29:54 2006 UTC (8 years, 9 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 truedfx 1.34 #!/usr/bin/perl -I/usr/lib/ufed
2 truedfx 1.20 use strict;
3 truedfx 1.27 use warnings;
4 blizzy 1.1
5 truedfx 1.20 # Copyright 1999-2005 Gentoo Foundation
6 blizzy 1.1 # Distributed under the terms of the GNU General Public License v2
7 truedfx 1.47 # $Header: /var/cvsroot/gentoo-src/ufed/ufed.pl,v 1.46 2006/04/25 12:51:07 truedfx Exp $
8 blizzy 1.1
9 truedfx 1.34 use Portage;
10 blizzy 1.1
11 truedfx 1.34 my $version = '0.40';
12 blizzy 1.1
13 truedfx 1.20 my %use_descriptions;
14    
15 truedfx 1.34 sub finalise(@);
16 truedfx 1.20 sub flags_dialog();
17     sub read_use_descs();
18 truedfx 1.28 sub save_flags(@);
19 truedfx 1.20
20 truedfx 1.41 delete $Portage::all_flags{'*'};
21    
22 truedfx 1.20 read_use_descs;
23    
24 truedfx 1.41 delete @use_descriptions{qw(bootstrap build)};
25    
26 truedfx 1.37 $Portage::all_flags{'-*'} = 1 if defined $Portage::make_conf_flags{'*'} && !$Portage::make_conf_flags{'*'};
27 truedfx 1.33
28 truedfx 1.34 Portage::merge %Portage::use_masked_flags, %Portage::archs;
29 truedfx 1.33
30 truedfx 1.34 for(keys %Portage::all_flags) {
31     @{$use_descriptions{$_}} = "(Unknown)"
32 truedfx 1.33 if not exists $use_descriptions{$_};
33 truedfx 1.20 }
34 truedfx 1.34 @{$use_descriptions{'-*'}} = 'Never enable any flags other than those specified in /etc/make.conf';
35 truedfx 1.20
36 truedfx 1.34 for(keys %Portage::use_masked_flags)
37     { delete $use_descriptions{$_} if $Portage::use_masked_flags{$_} }
38 truedfx 1.20
39 truedfx 1.34 flags_dialog;
40 truedfx 1.20
41 truedfx 1.34 sub finalise(@) {
42     my %flags;
43     @flags{@_} = ();
44 truedfx 1.33 if(exists $flags{'-*'}) {
45     return sort keys %flags;
46     } else {
47     my(@enabled, @disabled);
48     my %all_flags;
49 truedfx 1.34 @all_flags{keys %flags, keys %Portage::default_flags} = ();
50 truedfx 1.33 for(sort keys %all_flags) {
51     next if $_ eq '*';
52 truedfx 1.34 push @enabled, $_ if exists $flags{$_} && !$Portage::default_flags{$_};
53     push @disabled, "-$_" if $Portage::default_flags{$_} && !exists $flags{$_};
54 truedfx 1.33 }
55     return @enabled, @disabled;
56 truedfx 1.27 }
57     }
58    
59 truedfx 1.34 sub flags_dialog() {
60 truedfx 1.38 use POSIX ();
61 truedfx 1.42 POSIX::dup2 1, 3;
62     POSIX::dup2 1, 4;
63 truedfx 1.39 my ($iread, $iwrite) = POSIX::pipe;
64     my ($oread, $owrite) = POSIX::pipe;
65 truedfx 1.42 my $child = fork;
66 truedfx 1.38 die "fork() failed\n" if not defined $child;
67     if($child == 0) {
68 truedfx 1.39 POSIX::close $iwrite;
69     POSIX::close $oread;
70     POSIX::dup2 $iread, 3;
71 truedfx 1.42 POSIX::close $iread;
72     POSIX::dup2 $owrite, 4;
73     POSIX::close $owrite;
74 truedfx 1.39 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 truedfx 1.38 }
79 truedfx 1.39 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 truedfx 1.42 open my $fh, '<&=', $oread or die "Couldn't read output.\n";
100 truedfx 1.44 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 truedfx 1.39 { print "Cancelled, not saving changes.\n" }
107 truedfx 1.44 exit $rc;
108     } elsif(POSIX::WIFSIGNALED($?))
109     { kill POSIX::WTERMSIG($?), $$ }
110     else
111     { exit 127 }
112 truedfx 1.34 }
113 blizzy 1.1
114 truedfx 1.34 sub read_use_descs() {
115 truedfx 1.40 my %_use_descriptions;
116 truedfx 1.34 for my $dir(@Portage::portagedirs) {
117     for(Portage::noncomments "$dir/profiles/use.desc") {
118     my ($flag, $desc) = /^(.*?)\s+-\s+(.*)$/ or next;
119 truedfx 1.40 $_use_descriptions{$flag}{$desc} = 1;
120 truedfx 1.34 }
121 truedfx 1.46 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 truedfx 1.40 }
128     my %_use_local_descriptions;
129     for my $dir(@Portage::portagedirs) {
130 truedfx 1.34 for(Portage::noncomments "$dir/profiles/use.local.desc") {
131     my ($pkg, $flag, $desc) = /^(.*?):(.*?)\s+-\s+(.*)$/ or next;
132 truedfx 1.40 $_use_local_descriptions{$flag}{$desc}{$pkg} = 1;
133 truedfx 1.34 }
134     }
135 truedfx 1.40 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 truedfx 1.20 }
143    
144 truedfx 1.28 sub save_flags(@) {
145 truedfx 1.32 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 truedfx 1.26
158 truedfx 1.46 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 truedfx 1.20 my $contents;
172    
173 truedfx 1.22 {
174 truedfx 1.28 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 truedfx 1.22 local $/;
177 truedfx 1.25 $_ = <$makeconf>;
178     print $makeconfold $_;
179 truedfx 1.22 close $makeconfold;
180     close $makeconf;
181     }
182 truedfx 1.20
183 truedfx 1.47 my $sourcing = 0;
184 truedfx 1.25 eval {
185 truedfx 1.26 # 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 truedfx 1.45 pos = 0;
189 truedfx 1.25 for(;;) {
190 truedfx 1.32 if(/\G$UBLNK/gc) {
191     ($ucs, $uce) = ($-[1], $+[1]) if defined $1;
192     }
193 truedfx 1.27 last if pos == length;
194 truedfx 1.46 my $linestart;
195 truedfx 1.28 my $flagatstartofline = do {
196 truedfx 1.46 $linestart = 1+rindex $_, "\n", pos()-1;
197 truedfx 1.28 my $line = substr($_, $linestart, pos()-$linestart);
198     $line !~ /[^ \t]/;
199     };
200 truedfx 1.46 my $start = pos;
201 truedfx 1.26 /\G$IDENT/gc or die;
202 truedfx 1.25 my $name = $1;
203 truedfx 1.32 /\G$BLANK/gc;
204 truedfx 1.47 if($name ne 'source') {
205     /\G$ASSIG/gc or die;
206     /\G$BLANK/gc;
207     } else {
208     $sourcing = 1;
209     }
210 truedfx 1.32 die if pos == length;
211 truedfx 1.46 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 truedfx 1.28 }
227 truedfx 1.46 }
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 truedfx 1.28 } else {
248 truedfx 1.46 # no best tab size discussions, please. terminals use ts=8.
249     $length&=~8;
250     $length+=8;
251 truedfx 1.28 }
252 truedfx 1.46 }
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 truedfx 1.28 }
273     }
274 truedfx 1.25 }
275 truedfx 1.46 # 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 truedfx 1.25 }
282 truedfx 1.46 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 truedfx 1.28 if($length + 1 + length $flag <= 78) {
291     $flags .= " $flag";
292     $length += 1+length $flag;
293     } else {
294     $flags .= "\n $flag";
295 truedfx 1.46 $length = length($var) + 2 + length $flag;
296 truedfx 1.28 }
297     }
298     }
299 truedfx 1.46 substr($_, $ucs, $uce-$ucs) = "\n$var=\"$flags\"\n";
300 truedfx 1.25 }
301     };
302     die "Parse error when writing make.conf - did you modify it while ufed was running?\n" if $@;
303 truedfx 1.20
304 truedfx 1.47 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 truedfx 1.22 {
309 truedfx 1.28 open my $makeconf, '>', '/etc/make.conf' or die "Couldn't open /etc/make.conf\n";
310 truedfx 1.25 print $makeconf $_;
311 truedfx 1.22 close $makeconf;
312     }
313 truedfx 1.20 }

  ViewVC Help
Powered by ViewVC 1.1.20