Ticket #182: flagedit

File flagedit, 25.6 KB (added by eternaleye, 3 years ago)

Seemingly working portage + paludis flagedit -- Thank goodness for O'Reilly!

Line 
1#!/usr/bin/perl
2
3use strict;
4use Libconf qw(:helpers);
5use Libconf::Glueconf::Generic::KeyValue;
6use Libconf::Glueconf::Generic::Shell;
7
8my $portage = 0;
9my $paludis = 1;
10
11our $VERSION='0.0.7';
12my $paludis_uf_file = '/etc/paludis/use.conf';
13my $paludis_kw_file = '/etc/paludis/keywords.conf';
14my $paludis_brc = '/etc/paludis/bashrc';
15my $paludis_dir = '/etc/paludis';
16my $uf_file = '/etc/portage/package.use';
17my $kw_file = '/etc/portage/package.keywords';
18my $mc_file = '/etc/make.conf';
19my $portage_dir = '/usr/portage';
20my $alpha_order = 0;
21my $strict = 0;
22our $nowarn = 0;
23my (@actions, @keywords, $show, $list, $desc, $do_keyword);
24foreach my $i (0..@ARGV-1) {
25    member($ARGV[$i], '--help', '-h') and usage();
26    member($ARGV[$i], '--version', '-v') and version();
27    $ARGV[$i] eq '--package-file' and $uf_file = $ARGV[++$i], next;
28    $ARGV[$i] eq '--keywords-file' and $kw_file = $ARGV[++$i], next;
29    $ARGV[$i] eq '--make-conf-file' and $mc_file = $ARGV[++$i], next;
30    $ARGV[$i] eq '--portage-dir' and $portage_dir = $ARGV[++$i], next;
31    $ARGV[$i] eq '--alpha-order' and $alpha_order = 1, next;
32    $ARGV[$i] eq '--show' and $show = 1, next;
33    $ARGV[$i] eq '--list' and $list = 1, next;
34    $ARGV[$i] eq '--desc' and $desc = 1, next;
35    $ARGV[$i] eq '--strict' and $strict = 1, next;
36    $ARGV[$i] eq '--nowarn' and $nowarn = 1, next;
37    $ARGV[$i] eq '--keywords' || $ARGV[$i] eq '--' and $do_keyword = 1, next;
38    if ($do_keyword) {
39        push @keywords, $ARGV[$i];
40    } else {
41        push @actions, $ARGV[$i];
42    }
43}
44
45my $use_global_uf = !@actions || $actions[0] =~ /^(\+|\-|\%)/;
46!@actions and !$show and $show = 1;
47
48my $uf = { _plus => [], _minus => [], _order => [] };
49my $kw = { _plus => [], _minus => [], _order => [] };
50my $uf_desc_kw;
51my $uf_desc_uf;
52if ($paludis) {
53        $uf_desc_kw = { map { $_ => "stable keyword for $_", "~$_" => "unstable keyword for $_" } get_paludis_archlist() };
54} elsif ($portage) {
55        $uf_desc_kw = { map { $_ => "stable keyword for $_", "~$_" => "unstable keyword for $_" } get_archlist() };
56} else {
57        die "You have not selected either portage or paludis!"
58}
59if ($paludis) {
60        $uf_desc_uf = paludis_get_uf_desc();
61} elsif ($portage) {
62        $uf_desc_uf = get_uf_desc();
63} else {
64        die "You have not selected either portage or paludis!"
65}
66$uf_desc_uf->{'*'} = 'all the flags';
67$uf_desc_kw->{'*'} = 'all the keywords';
68
69my $uf_desc = $do_keyword ? $uf_desc_kw : $uf_desc_uf;
70if ($list) {
71    while(my ($key, $value) = each(%$uf_desc)) {
72        print "$key" . ($desc ? ": $value" : '') ."\n";
73    }
74    exit(0);
75}
76my ($flags, $package, $kwords);
77my $file;
78if ($paludis) {
79        if ($do_keyword) {
80            $file = $use_global_uf ? $paludis_kw_file : $paludis_kw_file;
81        } else {
82            $file = $use_global_uf ? $paludis_uf_file : $paludis_uf_file;
83        }
84} elsif ($portage) {
85        if ($do_keyword) {
86            $file = $use_global_uf ? $mc_file : $kw_file;
87        } else {
88            $file = $use_global_uf ? $mc_file : $uf_file;
89        }
90} else {
91        die "You have not selected either portage or paludis!"
92}
93-e $file or open FILE,">$file" or die "couldn't create empty '$file'"; close FILE;
94(-w $file || $show) && -r $file or die "'$file' is not a readable and writable file";
95
96if ($paludis) {
97        if ($use_global_uf) { 
98                my $bashrc = Libconf::Glueconf::Generic::Shell->new({ filename => $paludis_brc,
99                                                                        shell_style => 'true_bash',
100                                                                        shell_command => '/bin/bash',
101                                                                        });
102                string_2_uf($uf, $uf_desc_uf, $paludis_uf_file->{'* USE: '});
103                string_2_uf($kw, $uf_desc_kw, $paludis_kw_file->{'* '});
104                if ($show) {
105                        if ($do_keyword) {
106                        my $ak = $paludis_kw_file->{'* '};
107                        $ak ||= 'unset';
108                        print "global accepted keywords : $ak\n";
109                        } else {
110                        print uf_2_string($uf, $alpha_order) . "\n";
111                        }
112                } else {
113                        if (@actions > 0) {
114                        string_2_uf($uf, $uf_desc_uf, @actions);
115                        paludis_save_uf_flags(uf_2_string($uf, $alpha_order), $paludis_uf_file);
116                        }
117                        if ($do_keyword) {
118                        foreach my $keyword (@keywords) {
119                                if ($keyword eq '%') {
120                                my @a = @{$kw->{_order}};
121                                remove($kw, $_) foreach(@a);
122                                } else {
123                                string_2_uf($kw, $uf_desc_kw, $keyword);
124                                }
125                        }
126                        paludis_save_kw(uf_2_string($kw, $alpha_order), $paludis_kw_file);
127                        }
128                }
129       
130        } else {
131                $flags = Libconf::Glueconf::Generic::KeyValue->new({ filename => $paludis_uf_file,
132                                                                        separator_char => '(?:\s|$)',
133                                                                        output_separator_char => ' ',
134                                                                        allow_space => 1,
135                                                                        handle_quote => 0,
136                                                                        accept_empty_value => 1,
137                                                                });
138                if ($do_keyword) {
139                        $kwords = Libconf::Glueconf::Generic::KeyValue->new({ filename => $paludis_kw_file,
140                                                                        separator_char => '(?:\s|$)',
141                                                                        output_separator_char => ' ',
142                                                                        allow_space => 1,
143                                                                        handle_quote => 0,
144                                                                        accept_empty_value => 1,
145                                                                        });
146                }
147                $package = shift @actions;
148                if (!$show) {
149                        if (@actions > 0) {
150                        -e "$paludis_uf_file.old" and unlink("$paludis_uf_file.old") || die "couldn't remove $uf_file.old\n";
151                        open(FILE, $paludis_uf_file) or die "couldn't open $paludis_uf_file\n";
152                        open(OUTFILE, ">$paludis_uf_file.old") or die "couldn't write to $paludis_uf_file.old\n";
153                        { local $/; my $c = <FILE>; print OUTFILE $c; }
154                        }
155                        if ($do_keyword) {
156                        -e "$paludis_kw_file.old" and unlink("$paludis_kw_file.old") || die "couldn't remove $paludis_kw_file.old\n";
157                        open(FILE, $paludis_kw_file) or die "couldn't open $paludis_kw_file\n";
158                        open(OUTFILE, ">$paludis_kw_file.old") or die "couldn't write to $paludis_kw_file.old\n";
159                        { local $/; my $c = <FILE>; print OUTFILE $c; }
160                        }
161                }
162               
163                if ($package !~ m|/| ) {
164                        my @ext_package;
165                        foreach (keys %$flags, keys %$kwords) {
166                        m|/$package$| and push @ext_package, $_;
167                        }
168                        @ext_package > 1 and die "multiple package match : " . join (', ', @ext_package) . ". Specify more \n";
169                        @ext_package == 0 and die "no package matching $package were found. To add a new package, you have to fully specify it (for instance 'net-im/amsn').\n";
170                        $package = $ext_package[0];
171                }
172               
173                if (exists $flags->{$package}) {
174                        string_2_uf($uf, $uf_desc_uf, $flags->{$package});
175                }
176                if (exists $kwords->{$package}) {
177                        string_2_uf($kw, $uf_desc_kw, $kwords->{$package});
178                }
179                if ($show) {
180                        if ($do_keyword) {
181                        print uf_2_string($kw, $alpha_order) . "\n";
182                        } else {
183                        print uf_2_string($uf, $alpha_order) . "\n";
184                        }
185                } else {
186                        if (@actions > 0) {
187                        foreach my $action (@actions) {
188                                if ($action eq '%') {
189                                my @a = @{$uf->{_order}};
190                                remove($uf, $_) foreach(@a);
191                                } else {
192                                string_2_uf($uf, $uf_desc_uf, $action);
193                                }
194                        }
195                        my $s = uf_2_string($uf, $alpha_order);
196                        if (length($s)) {
197                                $flags->{$package} = $s;
198                        } else {
199                                delete $flags->{$package};
200                        }
201                        $flags->write_conf();
202                        }
203                        if (@keywords > 0) {
204                        foreach my $keyword (@keywords) {
205                                if ($keyword eq '%') {
206                                my @a = @{$kw->{_order}};
207                                remove($kw, $_) foreach(@a);
208                                } else {
209                                string_2_uf($kw, $uf_desc_kw, $keyword);
210                                }
211                        }
212                        my $s = uf_2_string($kw, $alpha_order);
213                        if (length($s)) {
214                                $kwords->{$package} = $s;
215                        } else {
216                                delete $kwords->{$package};
217                        }
218                        $kwords->write_conf();
219                        }
220                }
221        }
222} elsif ($portage) {
223        if ($use_global_uf) { 
224        my $make_conf = Libconf::Glueconf::Generic::Shell->new({ filename => $mc_file,
225                                                                shell_style => 'true_bash',
226                                                                shell_command => '/bin/bash',
227                                                                });
228        string_2_uf($uf, $uf_desc_uf, $make_conf->{USE});
229        string_2_uf($kw, $uf_desc_kw, $make_conf->{ACCEPT_KEYWORDS});
230        if ($show) {
231                if ($do_keyword) {
232                my $ak = $make_conf->{ACCEPT_KEYWORDS};
233                $ak ||= 'unset';
234                print "global accepted keywords : $ak\n";
235                } else {
236                print uf_2_string($uf, $alpha_order) . "\n";
237                }
238        } else {
239                if (@actions > 0) {
240                string_2_uf($uf, $uf_desc_uf, @actions);
241                save_mc_flags(uf_2_string($uf, $alpha_order), $mc_file);
242                }
243                if ($do_keyword) {
244                foreach my $keyword (@keywords) {
245                        if ($keyword eq '%') {
246                        my @a = @{$kw->{_order}};
247                        remove($kw, $_) foreach(@a);
248                        } else {
249                        string_2_uf($kw, $uf_desc_kw, $keyword);
250                        }
251                }
252                save_mc_kw(uf_2_string($kw, $alpha_order), $mc_file);
253                }
254        }
255       
256        } else {
257        $flags = Libconf::Glueconf::Generic::KeyValue->new({ filename => $uf_file,
258                                                                separator_char => '(?:\s|$)',
259                                                                output_separator_char => ' ',
260                                                                allow_space => 1,
261                                                                handle_quote => 0,
262                                                                accept_empty_value => 1,
263                                                        });
264        if ($do_keyword) {
265                $kwords = Libconf::Glueconf::Generic::KeyValue->new({ filename => $kw_file,
266                                                                separator_char => '(?:\s|$)',
267                                                                output_separator_char => ' ',
268                                                                allow_space => 1,
269                                                                handle_quote => 0,
270                                                                accept_empty_value => 1,
271                                                                });
272        }
273        $package = shift @actions;
274        if (!$show) {
275                if (@actions > 0) {
276                -e "$uf_file.old" and unlink("$uf_file.old") || die "couldn't remove $uf_file.old\n";
277                open(FILE, $uf_file) or die "couldn't open $uf_file\n";
278                open(OUTFILE, ">$uf_file.old") or die "couldn't write to $uf_file.old\n";
279                { local $/; my $c = <FILE>; print OUTFILE $c; }
280                }
281                if ($do_keyword) {
282                -e "$kw_file.old" and unlink("$kw_file.old") || die "couldn't remove $kw_file.old\n";
283                open(FILE, $kw_file) or die "couldn't open $kw_file\n";
284                open(OUTFILE, ">$kw_file.old") or die "couldn't write to $kw_file.old\n";
285                { local $/; my $c = <FILE>; print OUTFILE $c; }
286                }
287        }
288       
289        if ($package !~ m|/| ) {
290                my @ext_package;
291                foreach (keys %$flags, keys %$kwords) {
292                m|/$package$| and push @ext_package, $_;
293                }
294                @ext_package > 1 and die "multiple package match : " . join (', ', @ext_package) . ". Specify more \n";
295                @ext_package == 0 and die "no package matching $package were found. To add a new package, you have to fully specify it (for instance 'net-im/amsn').\n";
296                $package = $ext_package[0];
297        }
298       
299        if (exists $flags->{$package}) {
300                string_2_uf($uf, $uf_desc_uf, $flags->{$package});
301        }
302        if (exists $kwords->{$package}) {
303                string_2_uf($kw, $uf_desc_kw, $kwords->{$package});
304        }
305        if ($show) {
306                if ($do_keyword) {
307                print uf_2_string($kw, $alpha_order) . "\n";
308                } else {
309                print uf_2_string($uf, $alpha_order) . "\n";
310                }
311        } else {
312                if (@actions > 0) {
313                foreach my $action (@actions) {
314                        if ($action eq '%') {
315                        my @a = @{$uf->{_order}};
316                        remove($uf, $_) foreach(@a);
317                        } else {
318                        string_2_uf($uf, $uf_desc_uf, $action);
319                        }
320                }
321                my $s = uf_2_string($uf, $alpha_order);
322                if (length($s)) {
323                        $flags->{$package} = $s;
324                } else {
325                        delete $flags->{$package};
326                }
327                $flags->write_conf();
328                }
329                if (@keywords > 0) {
330                foreach my $keyword (@keywords) {
331                        if ($keyword eq '%') {
332                        my @a = @{$kw->{_order}};
333                        remove($kw, $_) foreach(@a);
334                        } else {
335                        string_2_uf($kw, $uf_desc_kw, $keyword);
336                        }
337                }
338                my $s = uf_2_string($kw, $alpha_order);
339                if (length($s)) {
340                        $kwords->{$package} = $s;
341                } else {
342                        delete $kwords->{$package};
343                }
344                $kwords->write_conf();
345                }
346        }
347        }
348} else {
349        die "You have not selected either portage or paludis!"
350}
351
352sub version {
353    print qq(
354Flagedit version $VERSION
355);
356    exit(0);
357}
358
359sub usage {
360    print qq(
361
362flagedit allows you to edit the use flags or the keywords for a particular
363ebuild, or for the whole system. a backup is done for each modified file, named
364file.old.
365
366Usage: flagedit [PACKAGE] [ACTIONS | -- KEYWORD_ACTIONS] [ OPTIONS ]
367
368Examples:
369 flagedit net-im/amsn --show     # shows the use flag set for net-im/amsn
370 flagedit net-im/amsn +gnome     # adds the gnome use flag to net-im/amsn
371 flagedit net-im/amsn -kde +xmms # adds the xmms use flag and set the -kde one
372 flagedit net-im/amsn %kde       # resets the kde use flag (it's removed from
373                                 #   the line)
374
375 flagedit %kde                   # resets the global use flag (it's removed in
376                                 #   make.conf)
377 flagedit +gnome -qt             # add gnome and -qt in make.conf
378
379 flagedit net-im/amsn -- %x86    # reset the x86 keyword for net-im/amsn
380 flagedit net-im/amsn -- +~ppc +~x86   # adds the ~ppc and ~x86 keywords for
381                                       #   net-im/amsn
382 flagedit net-im/amsn -- %       # resets the keywords for this package
383 flagedit -- +~x86               # sets ACCEPT_KEYWORDS to "~x86"
384                                 # in /etc/make.conf
385
386You can mix the flags and keywords :
387 flagedit net-im/amsn +gnome -- +~x86
388
389PACKAGE is a package name (like dev-ruby/ruby-atk). If no package is given,
390flagedit will edit the maine USE flags (in make.conf), or the main
391ACCEPT_KEYWORDS (in make.conf)
392
393ACTIONS are :
394+FLAG \t enable the FLAG. Example : +sse
395-FLAG \t disable the FLAG. Example : -sse
396%FLAG \t reset the FLAG to default. Example : %sse
397% \t reset the whole flags of PACKAGE to default.
398  \t In this case, PACKAGE is not optional
399
400KEYWORD_ACTIONS are :
401+KEYWORD \t enable the keyword. Example : +x86
402-KEYWORD \t disable the KEYWORD. Example : -~x86
403%KEYWORD \t reset the KEYWORD to default. Example : %x86
404% \t\t reset the whole keywords of PACKAGE to default.
405  \t\t In this case, PACKAGE is not optional
406
407
408OPTIONS are :
409  --package-file=<path>   specify an alternate package.use file (default is
410                            /etc/portage/package.use)
411  --make-conf-file=<path> specify an alternate make.conf file (default is
412                            /etc/make.conf)
413  --portage-dir=<path>    specify an alternate portage directory path (default
414                            is /usr/portage)
415  --alpha-order           sort the flags alphabetically instead of keeping the
416                            original order
417  --show                  don't edit, display the flags of the PACKAGE. If no
418                            package is given, display the system USE flags.
419  --list                  don't edit, display the entire list of possible flags.
420  --desc                  if specified with --list, display the flags
421                            description also.
422  --strict                if a specified flag name is invalid, dies, instead of
423                            just warning.
424  --nowarn                if a specified flag name is invalid, don't warn.
425  --help                  this help
426 
427see http://damz.net/flagedit/
428
429);
430    exit(0);   
431}
432
433sub paludisdirs {
434        my @paludisdirs;
435        while (<${paludis_dir}/repositories/*>) {
436                if (/location = (.+)/) {
437                        $1 =~ s/\${ROOT}/\//;
438                        push (@paludisdirs, $1);
439                }
440        }
441        @paludisdirs;
442}
443
444sub get_paludis_archlist {
445    my @arch_list;
446    foreach my $paludisdir (paludisdirs()) {
447        -e "$paludisdir/profiles/arch.list" or next;
448        my @l = map { chomp; $_ } cat_("$paludisdir/profiles/arch.list");
449        push @arch_list, @l;
450    }
451    @arch_list;
452}
453
454sub paludis_get_uf_desc {
455
456    ####
457    # list of USE flags
458
459    my $use_desc = {};
460
461    foreach my $paludisdir (paludisdirs()) {
462        -e "$paludisdir/profiles/use.desc" or warn "fatal error : couldn't find the flag descriptions `$paludisdir/profiles/use.desc').\n", next;
463        my $use_desc_struct = Libconf::Glueconf::Generic::KeyValue->new({ filename => "$paludisdir/profiles/use.desc",
464                                                                          separator_char => '\s-\s',
465                                                                          allow_space => 1,
466                                                                          handle_quote => 0,
467                                                                          accept_empty_value => 1,
468                                                                        });
469
470        while (my ($key, $value) = each %$use_desc_struct) {
471            $use_desc->{$key} = $value;
472        }
473        # get the use.local.desc description
474        -e "$paludisdir/profiles/use.local.desc" or
475          warn "warning : couldn't find the local descriptions `$paludisdir/profiles/use.local.desc'.\n", next;
476        my $use_local_desc = Libconf::Glueconf::Generic::KeyValue->new({ filename => "$paludisdir/profiles/use.local.desc",
477                                                                         separator_char => '\s-',
478                                                                         allow_space => 1,
479                                                                         handle_quote => 0,
480                                                                         accept_empty_value => 1,
481                                                                       });
482        # match the "package:flag - description" syntax and merge with use.desc
483        while (my ($key, $value) = each %$use_local_desc) {
484            my ($package, $flag) = split /:/, $key;
485            # the decription is added, not replaced, so that a flag can have multiple description
486            $use_desc->{$flag} .= (length($use_desc->{$flag}) ? ' --- ' : '') . "Local Flag: $value ($package)";
487        }
488    }
489
490    # we remove the internal flags not to be set by users, but not the masked flags.
491
492    foreach (keys %$use_desc) {
493        if ($use_desc->{$_} =~ /(\!\!internal use only\!\!)|(indicates.*(architecture|platform))/i) {
494            delete $use_desc->{$_};
495        }
496    }
497    $use_desc;
498}
499
500sub portdirs {
501    # default portage directory
502    my $make_conf = Libconf::Glueconf::Generic::Shell->new({ filename => $mc_file,
503                                                             shell_style => 'true_bash',
504                                                             shell_command => '/bin/bash',
505                                                           });
506
507    ($portage_dir, $make_conf->{PORTDIR_OVERLAY});
508}
509
510sub get_archlist {
511    my @arch_list;
512    foreach my $portdir (portdirs()) {
513        -e "$portdir/profiles/arch.list" or next;
514        my @l = map { chomp; $_ } cat_("$portdir/profiles/arch.list");
515        push @arch_list, @l;
516    }
517    @arch_list;
518}
519
520sub cat_ { my ($f, $e) = @_;
521           local *F;
522           open F, defined $e ? ("<:encoding($e)", $f) : $f or die "reading file $f failed: $!\n";
523           my @l = <F>;
524           wantarray() ? @l : join '', @l
525       }
526
527sub get_uf_desc {
528
529    ####
530    # list of USE flags
531
532    my $use_desc = {};
533
534    foreach my $portdir (portdirs()) {
535        -e "$portdir/profiles/use.desc" or warn "fatal error : couldn't find the flag descriptions `$portdir/profiles/use.desc').\n", next;
536        my $use_desc_struct = Libconf::Glueconf::Generic::KeyValue->new({ filename => "$portdir/profiles/use.desc",
537                                                                          separator_char => '\s-\s',
538                                                                          allow_space => 1,
539                                                                          handle_quote => 0,
540                                                                          accept_empty_value => 1,
541                                                                        });
542
543        while (my ($key, $value) = each %$use_desc_struct) {
544            $use_desc->{$key} = $value;
545        }
546        # get the use.local.desc description
547        -e "$portdir/profiles/use.local.desc" or
548          warn "warning : couldn't find the local descriptions `$portdir/profiles/use.local.desc'.\n", next;
549        my $use_local_desc = Libconf::Glueconf::Generic::KeyValue->new({ filename => "$portdir/profiles/use.local.desc",
550                                                                         separator_char => '\s-',
551                                                                         allow_space => 1,
552                                                                         handle_quote => 0,
553                                                                         accept_empty_value => 1,
554                                                                       });
555        # match the "package:flag - description" syntax and merge with use.desc
556        while (my ($key, $value) = each %$use_local_desc) {
557            my ($package, $flag) = split /:/, $key;
558            # the decription is added, not replaced, so that a flag can have multiple description
559            $use_desc->{$flag} .= (length($use_desc->{$flag}) ? ' --- ' : '') . "Local Flag: $value ($package)";
560        }
561    }
562
563    # we remove the internal flags not to be set by users, but not the masked flags.
564
565    foreach (keys %$use_desc) {
566        if ($use_desc->{$_} =~ /(\!\!internal use only\!\!)|(indicates.*(architecture|platform))/i) {
567            delete $use_desc->{$_};
568        }
569    }
570    $use_desc;
571}
572
573#while (my ($key, $value) = each %{$profile->{use_mask_hash}}) {
574#    $value or next;
575#    delete $use_desc->{$key};
576#}
577
578# add the flag from use.default if the corresponding package is installed
579#my %use_default_flags;
580#while (my ($flag, $package) = each %{$profile->{use_defaults}}) {
581#    if (defined($package)) {
582#        my @glob = glob("/var/db/pkg/$package-[0-9]*");
583#        @glob > 0 and $use_default_flags{$flag} = '+';
584#    }
585#}
586
587
588########
589
590
591
592
593
594sub string_2_uf {
595    my ($uf, $uf_desc, @strings) = @_;
596    foreach (split(/\s/, join(' ', @strings))) {
597        /^\+(.+)/ and add($uf, $uf_desc, $1, '+', '-', '_minus', '_plus', '+'), next;
598        /^\-(.+)/ and add($uf, $uf_desc, $1, '-', '+', '_plus', '_minus', '-'), next;
599        /^\%(.+)/ and remove($uf, $1), next;
600        add($uf, $uf_desc, $_, '+', '-', '_minus', '_plus', '+');
601    }
602}
603
604sub remove_from_list {
605    my ($elmt, $list) = @_;
606    my @tmp;
607    $_ eq $elmt or push(@tmp, $_) foreach (@{$list});
608    @{$list} = @tmp;
609}
610
611sub add {
612    my ($uf, $uf_desc, $flag, $a1, $a2, $a3, $a4, $a5) = @_;
613    $uf->{$flag} eq $a1 and return;
614    $uf->{$flag} eq $a2 and remove_from_list($flag, $uf->{$a3});
615    my $warn = "'$flag' seems to be a wrong flag";
616    (!$nowarn && !exists $uf_desc->{$flag}) and $strict ? die "fatal error : $warn\n" : warn "warning : $warn, I hope you know what you're doing\n";
617    push @{$uf->{$a4}}, $flag;
618    remove_from_list($flag, $uf->{_order});
619    push @{$uf->{_order}}, $flag;
620    $uf->{$flag} = $a5;
621}
622
623sub remove {
624    my ($uf, $flag) = @_;
625    remove_from_list($flag, $uf->{$_}) foreach (qw(_plus _minus _order));
626    delete $uf->{$flag};
627}
628
629sub uf_2_string {
630    my ($uf, $alpha_order) = @_;
631    join (' ', map { ($uf->{$_} eq '+' ? '' : '-') . $_ } ($alpha_order ? sort { uc($a) cmp uc($b) } @{$uf->{_order}} : @{$uf->{_order}}) );
632}
633
634# stolen from ufed
635sub save_mc_flags {
636    my ($flags, $make_conf_file) = @_;
637    my $contents;
638
639    -e "$make_conf_file.old" and unlink("$make_conf_file.old") || die "couldn't unlink $make_conf_file.old \n";
640    rename($make_conf_file, "$make_conf_file.old") or die "couldn't rename $make_conf_file\n";
641
642    open(FILE, "$make_conf_file.old") or die "couldn't open $make_conf_file.old", return;
643    open(OUTFILE, ">$make_conf_file") or die "couldn't open $make_conf_file", return;
644
645    { local $/; $contents = <FILE> }
646
647    if($contents =~ s/^([^\S\n]*)USE="[^"]*"/
648       my $i = $1;
649       $_ = qq(USE="$flags");
650       s!^!$i!mg; # preserve indentation
651       $_
652       /me) {
653        # nothing here, s/// did all the work
654    } elsif($contents =~ s/^\#USE=(.*)/\#USE=$1\nUSE="$flags"\n/m) {
655        # nothing here, s/// did all the work
656    } else {
657        $contents .= qq(\nUSE="$flags"\n);
658    }
659
660    print OUTFILE $contents;
661
662    close(OUTFILE);
663    close(FILE);
664
665    chmod(0644, $make_conf_file);
666}
667
668
669sub paludis_save_kw {
670    my ($flags, $paludis_kw_file) = @_;
671    my $contents;
672
673    -e "$paludis_kw_file.old" and unlink("$paludis_kw_file.old") || die "couldn't unlink $paludis_kw_file.old \n";
674    rename($paludis_kw_file, "$paludis_kw_file.old") or die "couldn't rename $paludis_kw_file\n";
675
676    open(FILE, "$paludis_kw_file.old") or die "couldn't open $paludis_kw_file.old", return;
677    open(OUTFILE, ">$paludis_kw_file") or die "couldn't open $paludis_kw_file", return;
678
679    { local $/; $contents = <FILE> }
680
681    if($contents =~ s/^([^\S\n]*)\* "[^"]*"/
682       my $i = $1;
683       $_ = qq(* "$flags");
684       s!^!$i!mg; # preserve indentation
685       $_
686       /me) {
687        # nothing here, s/// did all the work
688    } elsif($contents =~ s/^\#\* (.*)/\#\* $1\n\* "$flags"\n/m) {
689        # nothing here, s/// did all the work
690    } else {
691        $contents .= qq(\n* "$flags"\n);
692    }
693
694    print OUTFILE $contents;
695
696    close(OUTFILE);
697    close(FILE);
698
699    chmod(0644, $paludis_kw_file);
700}
701
702# stolen from ufed
703sub paludis_save_uf_flags {
704    my ($flags, $paludis_uf_file) = @_;
705    my $contents;
706
707    -e "$paludis_uf_file.old" and unlink("$paludis_uf_file.old") || die "couldn't unlink $paludis_uf_file.old \n";
708    rename($paludis_uf_file, "$paludis_uf_file.old") or die "couldn't rename $paludis_uf_file\n";
709
710    open(FILE, "$paludis_uf_file.old") or die "couldn't open $paludis_uf_file.old", return;
711    open(OUTFILE, ">$paludis_uf_file") or die "couldn't open $paludis_uf_file", return;
712
713    { local $/; $contents = <FILE> }
714
715    if($contents =~ s/^([^\S\n]*)\* "[^"]*"/
716       my $i = $1;
717       $_ = qq(USE="$flags");
718       s!^!$i!mg; # preserve indentation
719       $_
720       /me) {
721        # nothing here, s/// did all the work
722    } elsif($contents =~ s/^\#\* (.*)/\#\* $1\n\* "$flags"\n/m) {
723        # nothing here, s/// did all the work
724    } else {
725        $contents .= qq(\n* "$flags"\n);
726    }
727
728    print OUTFILE $contents;
729
730    close(OUTFILE);
731    close(FILE);
732
733    chmod(0644, $paludis_uf_file);
734}
735
736
737sub save_mc_kw {
738    my ($flags, $make_conf_file) = @_;
739    my $contents;
740
741    -e "$make_conf_file.old" and unlink("$make_conf_file.old") || die "couldn't unlink $make_conf_file.old \n";
742    rename($make_conf_file, "$make_conf_file.old") or die "couldn't rename $make_conf_file\n";
743
744    open(FILE, "$make_conf_file.old") or die "couldn't open $make_conf_file.old", return;
745    open(OUTFILE, ">$make_conf_file") or die "couldn't open $make_conf_file", return;
746
747    { local $/; $contents = <FILE> }
748
749    if($contents =~ s/^([^\S\n]*)ACCEPT_KEYWORDS="[^"]*"/
750       my $i = $1;
751       $_ = qq(ACCEPT_KEYWORDS="$flags");
752       s!^!$i!mg; # preserve indentation
753       $_
754       /me) {
755        # nothing here, s/// did all the work
756    } elsif($contents =~ s/^\#ACCEPT_KEYWORDS=(.*)/\#ACCEPT_KEYWORDS=$1\nACCEPT_KEYWORDS="$flags"\n/m) {
757        # nothing here, s/// did all the work
758    } else {
759        $contents .= qq(\nACCEPT_KEYWORDS="$flags"\n);
760    }
761
762    print OUTFILE $contents;
763
764    close(OUTFILE);
765    close(FILE);
766
767    chmod(0644, $make_conf_file);
768}