dh_getopt.pl

   1 #!/usr/bin/perl
   2 #
   3 # Because the getopt() program is so horribly broken, I wrote my own argument
   4 # processer that uses the find Getopt::Long module. This is used by all
   5 # debhelper scripts.
   6 #
   7 # Joey Hess, GPL copyright 1998.
   8
   9 # Returns a list of packages in the control file.
  10 # Must pass "arch" or "indep" to specify arch-dependant or -independant
  11 # packages.
  12 sub GetPackages { $type=shift;
  13         my $package;
  14         my $arch;
  15         my @list;
  16         open (CONTROL,"<debian/control") ||
  17                 ( $parse_error="cannot read debian/control: $!\n" );
  18         while (<CONTROL>) {
  19                 chomp;
  20                 s/\s+$//;
  21                 if (/^Package:\s+(.*)/) {
  22                         $package=$1;
  23                 }
  24                 if (/^Architecture:\s+(.*)/) {
  25                         $arch=$1;
  26                 }
  27                 if (!$_ or eof) { # end of stanza.
  28                         if ($package &&
  29                             (($type eq 'indep' && $arch eq 'all') ||
  30                                    ($type eq 'arch' && $arch ne 'all'))) {
  31                                 push @list, $package;
  32                                 undef $package, $arch;
  33                         }
  34                 }
  35         }
  36         close CONTROL;
  37
  38         return @list;
  39 }
  40
  41 # Passed an option name and an option value, adds packages to the list
  42 # of packages. We need this so the list will be built up in the right
  43 # order.
  44 sub AddPackage { my($option,$value)=@_;
  45         if ($option eq 'i' or $option eq 'indep') {
  46                 push @packages, GetPackages('indep');
  47                 $indep=1;
  48         }
  49         elsif ($option eq 'a' or $option eq 'arch') {
  50                 push @packages, GetPackages('arch');
  51                 $arch=1;
  52         }
  53         elsif ($option eq 'p' or $option eq 'package') {
  54                 push @packages, $value;
  55         }
  56         else {
  57                 $parse_error="bad option $option - should never happen!\n";
  58         }
  59 }
  60
  61 use Getopt::Long;
  62
  63 # Enable bundling of short command line options.
  64 Getopt::Long::config("bundling");
  65
  66 # Parse options.
  67 $ret=GetOptions(
  68         "v" => \$verbose,
  69         "verbose" => \$verbose,
  70
  71         "i" => \&AddPackage,
  72         "indep" => \&AddPackage,
  73
  74         "a" => \&AddPackage,
  75         "arch" => \&AddPackage,
  76
  77         "p=s" => \&AddPackage,
  78   "package=s" => \&AddPackage,
  79
  80         "n" => \$noscripts,
  81         "noscripts" => \$noscripts,
  82
  83         "x" => \$include, # is -x for some unknown historical reason..
  84         "include-conffiles" => \$include,
  85
  86         "d" => \$d_flag,
  87         "remove-d" => \$d_flag,
  88
  89         "r" => \$r_flag,
  90         "no-restart-on-upgrade" => \$r_flag,
  91
  92         "k" => \$k_flag,
  93         "keep" => \$k_flag,
  94
  95         "P=s" => \$tmpdir,
  96         "tmpdir=s" => \$tmpdir,
  97
  98         "u=s", => \$u_params,
  99         "update-rcd-params=s", => \$u_params,
 100   "dpkg-shlibdeps-params=s", => \$u_params,
 101
 102         "m=s", => \$major,
 103         "major=s" => \$major,
 104
 105         "V:s", => \$version_info,
 106         "version-info:s" => \$version_info,
 107
 108         "A" => \$all,
 109         "all" => \$all,
 110
 111         "no-act" => \$no_act,
 112
 113         "init-script=s" => \$init_script,
 114 );
 115
 116 if (!$ret) {
 117         $parse_error="exiting with unknown option.";
 118 }
 119
 120 # Check to see if -V was specified. If so, but no parameters were passed,
 121 # the variable will be defined but empty.
 122 if (defined($version_info)) {
 123         $version_info_set=1;
 124 }
 125
 126 # Check to see if DH_VERBOSE environment variable was set, if so, make sure
 127 # verbose is on.
 128 if ($ENV{DH_VERBOSE} ne undef) {
 129         $verbose=1;
 130 }
 131
 132 # Check to see if DH_NO_ACT was set, if so, make sure no act mode is on.
 133 if ($ENV{DH_NO_ACT} ne undef) {
 134         $no_act=1;
 135 }
 136
 137 # Now output everything, in a format suitable for a shell to eval it.
 138 # Note the last line sets $@ in the shell to whatever arguements remain.
 139 print qq{
 140 DH_VERBOSE='$verbose'
 141 DH_NO_ACT='$no_act'
 142 DH_DOPACKAGES='@packages'
 143 DH_DOINDEP='$indep'
 144 DH_DOARCH='$arch'
 145 DH_NOSCRIPTS='$noscripts'
 146 DH_EXCLUDE='$include'
 147 DH_D_FLAG='$d_flag'
 148 DH_R_FLAG='$r_flag'
 149 DH_K_FLAG='$k_flag'
 150 DH_TMPDIR='$tmpdir'
 151 DH_U_PARAMS='$u_params'
 152 DH_M_PARAMS='$major'
 153 DH_V_FLAG='$version_info'
 154 DH_V_FLAG_SET='$version_info_set'
 155 DH_PARAMS_ALL='$all'
 156 DH_INIT_SCRIPT='$init_script'
 157 DH_PARSE_ERROR='$parse_error'
 158 set -- @ARGV
 159 };