diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/Debian/Debhelper/Dh_Getopt.pm | 332 |
1 files changed, 332 insertions, 0 deletions
diff --git a/lib/Debian/Debhelper/Dh_Getopt.pm b/lib/Debian/Debhelper/Dh_Getopt.pm new file mode 100644 index 0000000..5486c41 --- /dev/null +++ b/lib/Debian/Debhelper/Dh_Getopt.pm @@ -0,0 +1,332 @@ +#!/usr/bin/perl +# +# Debhelper option processing library. +# +# Joey Hess GPL copyright 1998-2002 + +package Debian::Debhelper::Dh_Getopt; +use strict; +use warnings; + +use Debian::Debhelper::Dh_Lib; +use Getopt::Long; + +my (%exclude_package, %internal_excluded_package, %explicitly_requested_packages, %profile_enabled_packages, + $profile_excluded_pkg); + +sub showhelp { + my $prog=basename($0); + print "Usage: $prog [options]\n\n"; + print " $prog is a part of debhelper. See debhelper(7)\n"; + print " and $prog(1) for complete usage instructions.\n"; + exit(1); +} + +# Passed an option name and an option value, adds packages to the list +# of packages. We need this so the list will be built up in the right +# order. +sub AddPackage { my($option,$value)=@_; + if ($option eq 'i' or $option eq 'indep') { + push @{$dh{DOPACKAGES}}, getpackages('indep'); + $dh{DOINDEP}=1; + } + elsif ($option eq 'a' or $option eq 'arch' or + $option eq 's' or $option eq 'same-arch') { + push @{$dh{DOPACKAGES}}, getpackages('arch'); + $dh{DOARCH}=1; + if ($option eq 's' or $option eq 'same-arch') { + deprecated_functionality('-s/--same-arch is deprecated; please use -a/--arch instead', + 12, + '-s/--same-arch has been removed; please use -a/--arch instead' + ); + } + } + elsif ($option eq 'p' or $option eq 'package') { + assert_opt_is_known_package($value, '-p/--package'); + %profile_enabled_packages = map { $_ => 1 } getpackages('both') if not %profile_enabled_packages; + $explicitly_requested_packages{$value} = 1; + # Silently ignore packages that are not enabled by the + # profile. + if (exists($profile_enabled_packages{$value})) { + push @{$dh{DOPACKAGES}}, $value; + } else { + $profile_excluded_pkg = 1; + } + } + else { + error("bad option $option - should never happen!\n"); + } +} + +# Sets a package as the debug package. +sub SetDebugPackage { my($option,$value)=@_; + $dh{DEBUGPACKAGE} = $value; + # For backwards compatibility + $dh{DEBUGPACKAGES} = [$value]; +} + +# Add a package to a list of packages that should not be acted on. +sub ExcludePackage { + my($option, $value)=@_; + assert_opt_is_known_package($value, '-N/--no-package'); + $exclude_package{$value}=1; +} + +# Add another item to the exclude list. +sub AddExclude { + my($option,$value)=@_; + push @{$dh{EXCLUDE}},$value; +} + +# This collects non-options values. +sub NonOption { + push @{$dh{ARGV}}, @_; +} + +sub getoptions { + my $array=shift; + my %params=@_; + + if (! exists $params{bundling} || $params{bundling}) { + Getopt::Long::config("bundling"); + } + Getopt::Long::config('no_ignore_case'); + if ( ! -f 'debian/control' or ! compat(12, 1)) { + Getopt::Long::config('no_auto_abbrev'); + } + + my @test; + my %options=( + "v" => \$dh{VERBOSE}, + "verbose" => \$dh{VERBOSE}, + + "no-act" => \$dh{NO_ACT}, + + "i" => \&AddPackage, + "indep" => \&AddPackage, + + "a" => \&AddPackage, + "arch" => \&AddPackage, + + "p=s" => \&AddPackage, + "package=s" => \&AddPackage, + + "N=s" => \&ExcludePackage, + "no-package=s" => \&ExcludePackage, + + "remaining-packages" => \$dh{EXCLUDE_LOGGED}, + + "dbg-package=s" => \&SetDebugPackage, + + "s" => \&AddPackage, + "same-arch" => \&AddPackage, + + "n" => \$dh{NOSCRIPTS}, + "noscripts" => \$dh{NOSCRIPTS}, + "no-scripts" => \$dh{NOSCRIPTS}, + "o" => \$dh{ONLYSCRIPTS}, + "onlyscripts" => \$dh{ONLYSCRIPTS}, + "only-scripts" => \$dh{ONLYSCRIPTS}, + + "X=s" => \&AddExclude, + "exclude=s" => \&AddExclude, + + "d" => \$dh{D_FLAG}, + + "P=s" => \$dh{TMPDIR}, + "tmpdir=s" => \$dh{TMPDIR}, + + "u=s", => \$dh{U_PARAMS}, + + "V:s", => \$dh{V_FLAG}, + + "A" => \$dh{PARAMS_ALL}, + "all" => \$dh{PARAMS_ALL}, + + "h|help" => \&showhelp, + + "mainpackage=s" => \$dh{MAINPACKAGE}, + + "name=s" => \$dh{NAME}, + + "error-handler=s" => \$dh{ERROR_HANDLER}, + + "O=s" => sub { push @test, $_[1] }, + + (ref $params{options} ? %{$params{options}} : ()) , + + "<>" => \&NonOption, + ); + + if ($params{test}) { + foreach my $key (keys %options) { + $options{$key}=sub {}; + } + } + + my $oldwarn; + if ($params{test} || $params{ignore_unknown_options}) { + $oldwarn=$SIG{__WARN__}; + $SIG{__WARN__}=sub {}; + } + my $ret=Getopt::Long::GetOptionsFromArray($array, %options); + if ($params{test} || $params{ignore_unknown_options}) { + $SIG{__WARN__}=$oldwarn; + } + + foreach my $opt (@test) { + # Try to parse an option, and skip it + # if it is not known. + if (getoptions([$opt], %params, + ignore_unknown_options => 0, + test => 1)) { + getoptions([$opt], %params); + } + } + + return 1 if $params{ignore_unknown_options}; + return $ret; +} + +sub split_options_string { + my $str=shift; + $str=~s/^\s+//; + return split(/\s+/,$str); +} + +# Parse options and set %dh values. +sub parseopts { + my %params=@_; + + my @ARGV_extra; + + # DH_INTERNAL_OPTIONS is used to pass additional options from + # dh through an override target to a command. + if (defined $ENV{DH_INTERNAL_OPTIONS}) { + @ARGV_extra=split(/\x1e/, $ENV{DH_INTERNAL_OPTIONS}); + getoptions(\@ARGV_extra, %params); + + # Avoid forcing acting on packages specified in + # DH_INTERNAL_OPTIONS. This way, -p can be specified + # at the command line to act on a specific package, but when + # nothing is specified, the excludes will cause the set of + # packages DH_INTERNAL_OPTIONS specifies to be acted on. + if (defined $dh{DOPACKAGES}) { + foreach my $package (getpackages()) { + if (! grep { $_ eq $package } @{$dh{DOPACKAGES}}) { + $exclude_package{$package} = 1; + $internal_excluded_package{$package} = 1; + } + } + } + delete $dh{DOPACKAGES}; + delete $dh{DOINDEP}; + delete $dh{DOARCH}; + } + + # DH_OPTIONS can contain additional options to be parsed like @ARGV + if (defined $ENV{DH_OPTIONS}) { + @ARGV_extra=split_options_string($ENV{DH_OPTIONS}); + my $ret=getoptions(\@ARGV_extra, %params); + if (!$ret) { + warning("ignored unknown options in DH_OPTIONS"); + } + } + + my $ret=getoptions(\@ARGV, %params); + if (!$ret) { + if (! compat(7)) { + error("unknown option or error during option parsing; aborting"); + } + } + + # Check to see if -V was specified. If so, but no parameters were + # passed, the variable will be defined but empty. + if (defined($dh{V_FLAG})) { + $dh{V_FLAG_SET}=1; + } + + # If we have not been given any packages to act on, assume they + # want us to act on them all. Note we have to do this before excluding + # packages out, below. + if (! defined $dh{DOPACKAGES} || ! @{$dh{DOPACKAGES}}) { + my $do_exit = 0; + if ($profile_excluded_pkg) { + if (! $dh{BLOCK_NOOP_WARNINGS}) { + warning('All requested packages have been excluded' + . ' (e.g. via a Build-Profile or due to architecture restrictions).'); + } + $do_exit = 1; + } + if ($dh{DOINDEP} || $dh{DOARCH}) { + # User specified that all arch (in)dep package be + # built, and there are none of that type. + if (! $dh{BLOCK_NOOP_WARNINGS}) { + warning("You asked that all arch in(dep) packages be built, but there are none of that type."); + } + $do_exit = 1; + } + exit(0) if $do_exit; + push @{$dh{DOPACKAGES}},getpackages("both"); + } + + # Remove excluded packages from the list of packages to act on. + # Also unique the list, in case some options were specified that + # added a package to it twice. + my (@package_list, $package, %packages_seen); + foreach $package (@{$dh{DOPACKAGES}}) { + if (defined($dh{EXCLUDE_LOGGED}) && + grep { $_ eq $Debian::Debhelper::Dh_Lib::TOOL_NAME } load_log($package)) { + $exclude_package{$package}=1; + } + if (! $exclude_package{$package}) { + if (! exists $packages_seen{$package}) { + $packages_seen{$package}=1; + push @package_list, $package; + } + } + } + @{$dh{DOPACKAGES}}=@package_list; + + if (! defined $dh{DOPACKAGES} || ! @{$dh{DOPACKAGES}}) { + if (! $dh{BLOCK_NOOP_WARNINGS}) { + my %archs; + if (%explicitly_requested_packages) { + # Avoid sending a confusing error message when debhelper must exclude a package given via -p. + # This commonly happens due to Build-Profiles or/and when build only a subset of the packages + # (e.g. dpkg-buildpackage -A vs. -B vs. none of the options) + for my $pkg (sort(keys(%explicitly_requested_packages))) { + if (exists($internal_excluded_package{$pkg}) or not exists($profile_enabled_packages{$pkg})) { + delete($explicitly_requested_packages{$pkg}); + } + } + if (not %explicitly_requested_packages) { + warning('All requested packages have been excluded' + . ' (e.g. via a Build-Profile or due to architecture restrictions).'); + exit(0); + } + } + for my $pkg (getpackages()) { + $archs{package_declared_arch($pkg)} = 1; + } + warning("No packages to build. Possible architecture mismatch: " . hostarch() . + ", want: " . join(" ", sort keys %archs)); + } + exit(0); + } + + if (defined $dh{U_PARAMS}) { + # Split the U_PARAMS up into an array. + my $u=$dh{U_PARAMS}; + undef $dh{U_PARAMS}; + push @{$dh{U_PARAMS}}, split(/\s+/,$u); + } + + # Anything left in @ARGV is options that appeared after a -- + # These options are added to the U_PARAMS array, while the + # non-option values we collected replace them in @ARGV; + push @{$dh{U_PARAMS}}, @ARGV, @ARGV_extra; + @ARGV=@{$dh{ARGV}} if exists $dh{ARGV}; +} + +1 |