|
Michal Marek |
411abb |
#!/usr/bin/perl -w
|
|
|
174a64 |
##############################################################################
|
|
Michal Marek |
411abb |
# Copyright (c) 2003-2007,2009 Novell, Inc.
|
|
|
174a64 |
# Copyright (c) 2010-2022 SUSE LLC
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
# This program is free software; you can redistribute it and/or
|
|
Michal Marek |
411abb |
# modify it under the terms of version 2 of the GNU General Public License as
|
|
Michal Marek |
411abb |
# published by the Free Software Foundation.
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
# This program is distributed in the hope that it will be useful,
|
|
Michal Marek |
411abb |
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Michal Marek |
411abb |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
Michal Marek |
411abb |
# GNU General Public License for more details.
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
# You should have received a copy of the GNU General Public License
|
|
|
174a64 |
# along with this program; if not, contact https://www.suse.com/source-code/
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
#############################################################################
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
# Guards:
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
# +xxx include if xxx is defined
|
|
Michal Marek |
411abb |
# -xxx exclude if xxx is defined
|
|
Michal Marek |
411abb |
# +!xxx include if xxx is not defined
|
|
Michal Marek |
411abb |
# -!xxx exclude if xxx is not defined
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
use FileHandle;
|
|
Michal Marek |
411abb |
use Getopt::Long;
|
|
Michal Marek |
411abb |
use strict;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
# Prototypes
|
|
Michal Marek |
411abb |
sub files_in($$);
|
|
Michal Marek |
411abb |
sub parse($$);
|
|
Michal Marek |
411abb |
sub help();
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
sub slashme($) {
|
|
Michal Marek |
411abb |
my ($dir) = @_;
|
|
Michal Marek |
411abb |
$dir =~ s#([^/])$#$&/;; # append a slash if necessary
|
|
Michal Marek |
411abb |
if ($dir eq './') {
|
|
Michal Marek |
411abb |
return '';
|
|
Michal Marek |
411abb |
} else {
|
|
Michal Marek |
411abb |
return $dir;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
# Generate a list of files in a directory
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
sub files_in($$) {
|
|
Michal Marek |
411abb |
my ($dir, $path) = @_;
|
|
Michal Marek |
411abb |
my $dh = new FileHandle;
|
|
Michal Marek |
411abb |
my (@files, $file);
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
61c3df |
# @<file> syntax
|
|
Michal Marek |
61c3df |
if ($path =~ s/^@//) {
|
|
Michal Marek |
61c3df |
my $fh;
|
|
Michal Marek |
61c3df |
open($fh, '<', $path) or die "$path: $!\n";
|
|
Michal Marek |
61c3df |
@files = <$fh>;
|
|
Michal Marek |
61c3df |
close($fh);
|
|
Michal Marek |
61c3df |
chomp(@files);
|
|
Michal Marek |
61c3df |
s:^$dir:: for @files;
|
|
Michal Marek |
61c3df |
return @files;
|
|
Michal Marek |
61c3df |
}
|
|
Jean Delvare |
d8089e |
|
|
Michal Marek |
61c3df |
$path = slashme($path);
|
|
Michal Marek |
411abb |
opendir $dh, length("$dir$path") ? "$dir$path" : '.'
|
|
Michal Marek |
411abb |
or die "$dir$path: $!\n";
|
|
Michal Marek |
411abb |
while ($file = readdir($dh)) {
|
|
Michal Marek |
411abb |
next if $file =~ /^(\.|\.\.|\.#.*|CVS|.*~)$/;
|
|
Michal Marek |
411abb |
if (-d "$dir$path$file") {
|
|
Michal Marek |
411abb |
@files = (@files, files_in($dir, "$path$file/"));
|
|
Michal Marek |
411abb |
} else {
|
|
Michal Marek |
411abb |
#print "[$path$file]\n";
|
|
Michal Marek |
411abb |
push @files, "$path$file";
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
closedir $dh;
|
|
Michal Marek |
411abb |
return @files;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
# Parse a configuration file
|
|
Michal Marek |
411abb |
# Callback called with ($patch, @guards) arguments
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
sub parse($$) {
|
|
Michal Marek |
411abb |
my ($fh, $callback) = @_;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
my $line = "";
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
while (<$fh>) {
|
|
Michal Marek |
411abb |
chomp;
|
|
Michal Marek |
411abb |
s/(^|\s+)#.*//;
|
|
Michal Marek |
411abb |
if (s/\\$/ /) {
|
|
Michal Marek |
411abb |
$line .= $_;
|
|
Michal Marek |
411abb |
next;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
$line .= $_;
|
|
Jean Delvare |
d8089e |
my @guards = ();
|
|
Michal Marek |
411abb |
foreach my $token (split /[\s\t\n]+/, $line) {
|
|
Michal Marek |
411abb |
next if $token eq "";
|
|
Michal Marek |
411abb |
if ($token =~ /^[-+]/) {
|
|
Michal Marek |
411abb |
push @guards, $token;
|
|
Michal Marek |
411abb |
} else {
|
|
Michal Marek |
411abb |
#print "[" . join(",", @guards) . "] $token\n";
|
|
Michal Marek |
411abb |
&$callback($token, @guards);
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
$line = "";
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
# Command line options
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
my ($dir, $config, $default, $check, $list, $invert_match, $with_guards) =
|
|
Michal Marek |
411abb |
( '', '-', 1, 0, 0, 0, 0);
|
|
Michal Marek |
411abb |
my @path;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
# Help text
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
sub help() {
|
|
Michal Marek |
411abb |
print "$0 - select from a list of files guarded by conditions\n";
|
|
Michal Marek |
411abb |
print "SYNOPSIS: $0 [--prefix=dir] [--path=dir1:dir2:...]\n" .
|
|
Michal Marek |
411abb |
" [--default=0|1] [--check|--list] [--invert-match]\n" .
|
|
Michal Marek |
411abb |
" [--with-guards] [--config=file] symbol ...\n\n" .
|
|
Michal Marek |
61c3df |
" Defaults: --default=$default\n" .
|
|
Michal Marek |
61c3df |
" Use --path=\@<file> to read the list of entries from <file>\n";
|
|
Michal Marek |
411abb |
exit 0;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
# Parse command line options
|
|
Michal Marek |
411abb |
#
|
|
Michal Marek |
411abb |
Getopt::Long::Configure ("bundling");
|
|
Michal Marek |
411abb |
eval {
|
|
Michal Marek |
411abb |
unless (GetOptions (
|
|
Michal Marek |
411abb |
'd|prefix=s' => \$dir,
|
|
Michal Marek |
411abb |
'c|config=s' => \$config,
|
|
Michal Marek |
411abb |
'C|check' => \$check,
|
|
Michal Marek |
411abb |
'l|list' => \$list,
|
|
Michal Marek |
411abb |
'w|with-guards' => \$with_guards,
|
|
Michal Marek |
411abb |
'p|path=s' => \@path,
|
|
Michal Marek |
411abb |
'D|default=i' => \$default,
|
|
Michal Marek |
411abb |
'v|invert-match' => \$invert_match,
|
|
Michal Marek |
411abb |
'h|help' => sub { help(); exit 0; })) {
|
|
Michal Marek |
411abb |
help();
|
|
Michal Marek |
411abb |
exit 1;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
};
|
|
Michal Marek |
411abb |
if ($@) {
|
|
Michal Marek |
411abb |
print "$@";
|
|
Michal Marek |
411abb |
help();
|
|
Michal Marek |
411abb |
exit 1;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
@path = ('.')
|
|
Michal Marek |
411abb |
unless (@path);
|
|
Michal Marek |
411abb |
@path = split(/:/, join(':', @path));
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
my $fh = ($config eq '-') ? \*STDIN : new FileHandle($config)
|
|
Michal Marek |
411abb |
or die "$config: $!\n";
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
$dir = slashme($dir);
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
if ($check) {
|
|
Michal Marek |
411abb |
# Check for duplicate files, or for files that are not referenced by
|
|
Michal Marek |
411abb |
# the specification.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
my $problems = 0;
|
|
Michal Marek |
411abb |
my @files;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
foreach (@path) {
|
|
Jean Delvare |
d8089e |
@files = (@files, files_in($dir, $_));
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
my %files = map { $_ => 0 } @files;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
parse($fh, sub {
|
|
Michal Marek |
411abb |
my ($patch, @guards) = @_;
|
|
Michal Marek |
411abb |
if (exists $files{$patch}) {
|
|
Michal Marek |
411abb |
$files{$patch}++;
|
|
Michal Marek |
411abb |
} else {
|
|
Michal Marek |
9b71e7 |
if ($config eq '-') {
|
|
Michal Marek |
9b71e7 |
print "Not found: $dir$patch\n";
|
|
Michal Marek |
9b71e7 |
} else {
|
|
Jean Delvare |
3fbe9e |
print "In $config but not found: $dir$patch\n";
|
|
Michal Marek |
9b71e7 |
}
|
|
Michal Marek |
411abb |
$problems++;
|
|
Michal Marek |
411abb |
}});
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
$fh->close();
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
my ($file, $ref);
|
|
Michal Marek |
411abb |
while (($file, $ref) = each %files) {
|
|
Michal Marek |
411abb |
next if $ref == 1;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
if ($ref == 0) {
|
|
Michal Marek |
b39543 |
if ($config eq '-') {
|
|
Michal Marek |
b39543 |
print "Unused: $file\n";
|
|
Michal Marek |
b39543 |
} else {
|
|
Michal Marek |
b39543 |
print "Not in $config: $file\n";
|
|
Michal Marek |
b39543 |
}
|
|
Michal Marek |
411abb |
$problems++;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
if ($ref > 1) {
|
|
Michal Marek |
b39543 |
print "Warning: multiple uses";
|
|
Michal Marek |
b39543 |
print " in $config" if $config ne '-';
|
|
Michal Marek |
b39543 |
print ": $file\n";
|
|
Michal Marek |
411abb |
# This is not an error if the entries are mutually exclusive...
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
exit $problems ? 1 : 0;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
} elsif ($list) {
|
|
Michal Marek |
411abb |
parse($fh, sub {
|
|
Michal Marek |
411abb |
my ($patch, @guards) = @_;
|
|
Michal Marek |
411abb |
print join(' ', @guards), ' '
|
|
Michal Marek |
411abb |
if (@guards && $with_guards);
|
|
Michal Marek |
411abb |
print "$dir$patch\n";
|
|
Michal Marek |
411abb |
});
|
|
Michal Marek |
411abb |
} else {
|
|
Michal Marek |
411abb |
# Generate a list of patches to apply.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
my %symbols = map { $_ => 1 } @ARGV;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
parse($fh, sub {
|
|
Michal Marek |
411abb |
my ($patch, @guards) = @_;
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
my $selected;
|
|
Michal Marek |
411abb |
if (@guards) {
|
|
Michal Marek |
411abb |
# If the first guard is -xxx, the patch is included by default;
|
|
Michal Marek |
411abb |
# if it is +xxx, the patch is excluded by default.
|
|
Michal Marek |
411abb |
$selected = ($guards[0] =~ /^-/);
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
foreach (@guards) {
|
|
Michal Marek |
411abb |
/^([-+])(!?)(.*)?/
|
|
Michal Marek |
411abb |
or die "Bad guard '$_'\n";
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
# Check if the guard matches
|
|
Michal Marek |
411abb |
if (($2 eq '!' && !exists $symbols{$3}) ||
|
|
Michal Marek |
411abb |
($2 eq '' && ( $3 eq '' || exists $symbols{$3}))) {
|
|
Michal Marek |
411abb |
# Include or exclude
|
|
Michal Marek |
411abb |
$selected = ($1 eq '+');
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
} else {
|
|
Michal Marek |
411abb |
# If there are no guards, use the specified default result.
|
|
Michal Marek |
411abb |
$selected = $default;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
print "$dir$patch\n"
|
|
Michal Marek |
411abb |
if $selected ^ $invert_match;
|
|
Michal Marek |
411abb |
});
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
$fh->close();
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
exit 0;
|
|
Michal Marek |
411abb |
}
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
__END__
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
=head1 NAME
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
guards - select from a list of files guarded by conditions
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
=head1 SYNOPSIS
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
F<guards> [--prefix=F<dir>] [--path=F<dir1:dir2:...>] [--default=<0|1>]
|
|
Jean Delvare |
7fd413 |
[--check|--list] [--invert-match] [--with-guards] [--config=<file>]
|
|
Jean Delvare |
7fd413 |
I<symbol> ...
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
=head1 DESCRIPTION
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
The script reads a configuration file that may contain so-called guards, file
|
|
Michal Marek |
411abb |
names, and comments, and writes those file names that satisfy all guards to
|
|
Michal Marek |
411abb |
standard output. The script takes a list of symbols as its arguments. Each line
|
|
Michal Marek |
411abb |
in the configuration file is processed separately. Lines may start with a
|
|
Michal Marek |
411abb |
number of guards. The following guards are defined:
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
=over
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
+I<xxx> Include the file(s) on this line if the symbol I<xxx> is defined.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
-I<xxx> Exclude the file(s) on this line if the symbol I<xxx> is defined.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
+!I<xxx> Include the file(s) on this line if the symbol I<xxx> is not defined.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
-!I<xxx> Exclude the file(s) on this line if the symbol I<xxx> is not defined.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
- Exclude this file. Used to avoid spurious I<--check> messages.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
=back
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
The guards are processed left to right. The last guard that matches determines
|
|
Michal Marek |
411abb |
if the file is included. If no guard is specified, the I<--default>
|
|
Michal Marek |
411abb |
setting determines if the file is included.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
If no configuration file is specified, the script reads from standard input.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
The I<--check> option is used to compare the specification file against the
|
|
Michal Marek |
411abb |
file system. If files are referenced in the specification that do not exist, or
|
|
Michal Marek |
411abb |
if files are not enlisted in the specification file warnings are printed. The
|
|
Michal Marek |
411abb |
I<--path> option can be used to specify which directory or directories to scan.
|
|
Jean Delvare |
ce654f |
Multiple directories are separated by a colon (C<:>) character. The
|
|
Jean Delvare |
7fd413 |
I<--prefix> option specifies the location of the files. Alternatively, the
|
|
Jean Delvare |
7fd413 |
I<--path=@E<lt>fileE<gt>> syntax can be used to specify a file from which the
|
|
Jean Delvare |
7fd413 |
file names will be read.
|
|
Michal Marek |
411abb |
|
|
Jean Delvare |
2e074c |
Use I<--list> to list all files independent of any rules. Use I<--invert-match>
|
|
Michal Marek |
411abb |
to list only the excluded patches. Use I<--with-guards> to also include all
|
|
Michal Marek |
411abb |
inclusion and exclusion rules.
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
=head1 AUTHOR
|
|
Michal Marek |
411abb |
|
|
Michal Marek |
411abb |
Andreas Gruenbacher <agruen@suse.de>, SUSE Labs
|