Dh_Getopt.pm

   1 #!/usr/bin/perl -w
   2 #
   3 # Debhelper option processing library.
   4 #
   5 # Joey Hess GPL copyright 1998.
   6
   7 package Dh_Getopt;
   8 use strict;
   9
  10 use Dh_Lib;
  11 use Getopt::Long;
  12 use Exporter;
  13 #use vars qw{@ISA @EXPORT};
  14 #@ISA=qw(Exporter);
  15 #@EXPORT=qw(&aparseopts); # FIXME: for some reason, this doesn't work.
  16
  17 my (%options, %exclude_package);
  18
  19 # Passed an option name and an option value, adds packages to the list
  20 # of packages. We need this so the list will be built up in the right
  21 # order.
  22 sub AddPackage { my($option,$value)=@_;
  23         if ($option eq 'i' or $option eq 'indep') {
  24                 push @{$options{DOPACKAGES}}, GetPackages('indep');
  25                 $options{DOINDEP}=1;
  26         }
  27         elsif ($option eq 'a' or $option eq 'arch') {
  28                 push @{$options{DOPACKAGES}}, GetPackages('arch');
  29                 $options{DOARCH}=1;
  30         }
  31         elsif ($option eq 'p' or $option eq 'package') {
  32                 push @{$options{DOPACKAGES}}, $value;
  33         }
  34         elsif ($option eq 's' or $option eq 'same-arch') {
  35                 push @{$options{DOPACKAGES}}, GetPackages('same');
  36                 $options{DOSAME}=1;
  37         }
  38         else {
  39                 error("bad option $option - should never happen!\n");
  40         }
  41 }
  42
  43 # Add a package to a list of packages that should not be acted on.
  44 sub ExcludePackage { my($option,$value)=@_;
  45         $exclude_package{$value}=1;
  46 }
  47
  48 # Add another item to the exclude list.
  49 sub AddExclude { my($option,$value)=@_;
  50         push @{$options{EXCLUDE}},$value;
  51 }
  52
  53 # Parse options and return a hash of the values.
  54 sub parseopts {
  55         undef %options;
  56
  57         my $ret=GetOptions(
  58                 "v" => \$options{VERBOSE},
  59                 "verbose" => \$options{VERBOSE},
  60
  61                 "i" => \&AddPackage,
  62                 "indep" => \&AddPackage,
  63
  64                 "a" => \&AddPackage,
  65                 "arch" => \&AddPackage,
  66
  67                 "p=s" => \&AddPackage,
  68                 "package=s" => \&AddPackage,
  69
  70                 "s" => \&AddPackage,
  71                 "same-arch" => \&AddPackage,
  72
  73                 "N=s" => \&ExcludePackage,
  74                 "no-package=s" => \&ExcludePackage,
  75
  76                 "n" => \$options{NOSCRIPTS},
  77                 "noscripts" => \$options{NOSCRIPTS},
  78
  79                 "x" => \$options{INCLUDE_CONFFILES}, # is -x for some unknown historical reason..
  80                 "include-conffiles" => \$options{INCLUDE_CONFFILES},
  81
  82                 "X=s" => \&AddExclude,
  83                 "exclude=s" => \&AddExclude,
  84
  85                 "d" => \$options{D_FLAG},
  86                 "remove-d" => \$options{D_FLAG},
  87
  88                 "r" => \$options{R_FLAG},
  89                 "no-restart-on-upgrade" => \$options{R_FLAG},
  90
  91                 "k" => \$options{K_FLAG},
  92                 "keep" => \$options{K_FLAG},
  93
  94                 "P=s" => \$options{TMPDIR},
  95                 "tmpdir=s" => \$options{TMPDIR},
  96
  97                 "u=s", => \$options{U_PARAMS},
  98                 "update-rcd-params=s", => \$options{U_PARAMS},
  99                 "dpkg-shlibdeps-params=s", => \$options{U_PARAMS},
 100                 "dpkg-gencontrol-params=s", => \$options{U_PARAMS},
 101
 102                 "m=s", => \$options{M_PARAMS},
 103                 "major=s" => \$options{M_PARAMS},
 104
 105                 "V:s", => \$options{V_FLAG},
 106                 "version-info:s" => \$options{V_FLAG},
 107
 108                 "A" => \$options{PARAMS_ALL},
 109                 "all" => \$options{PARAMS_ALL},
 110
 111                 "no-act" => \$options{NO_ACT},
 112
 113                 "init-script=s" => \$options{INIT_SCRIPT},
 114         );
 115
 116         if (!$ret) {
 117                 error("unknown option; aborting");
 118         }
 119
 120         # Check to see if -V was specified. If so, but no parameters were
 121         # passed, the variable will be defined but empty.
 122         if (defined($options{V_FLAG})) {
 123                 $options{V_FLAG_SET}=1;
 124         }
 125
 126         # If we have not been given any packages to act on, assume they
 127         # want us to act on them all. Note we have to do this before excluding
 128         # packages out, below.
 129         if (! defined $options{DOPACKAGES} || ! @{$options{DOPACKAGES}}) {
 130                 if ($options{DOINDEP} || $options{DOARCH} || $options{DOSAME}) {
 131                                 # User specified that all arch (in)dep package be
 132                                 # built, and there are none of that type.
 133                                 error("I have no package to build");
 134                 }
 135                 push @{$options{DOPACKAGES}},GetPackages();
 136         }
 137
 138         # Remove excluded packages from the list of packages to act on.
 139         my @package_list;
 140         my $package;
 141         foreach $package (@{$options{DOPACKAGES}}) {
 142                 if (! $exclude_package{$package}) {
 143                         push @package_list, $package;
 144                 }
 145         }
 146         @{$options{DOPACKAGES}}=@package_list;
 147
 148         # Generate EXCLUDE_FIND.
 149         $options{EXCLUDE_FIND}='';
 150         foreach (@{$options{EXCLUDE}}) {
 151                 $options{EXCLUDE_FIND}.="-regex .*".quotemeta($_).".* -or ";
 152         }
 153         $options{EXCLUDE_FIND}=~s/ -or $//;
 154
 155         # If there are no packages to act on now, it's an error.
 156         if (! defined $options{DOPACKAGES} || ! @{$options{DOPACKAGES}}) {
 157                 error("I have no package to build");
 158         }
 159
 160         return %options;
 161 }
 162
 163 sub import {
 164         # Enable bundling of short command line options.
 165         Getopt::Long::config("bundling");
 166 }
 167
 168 1