]> git.donarmstrong.com Git - debhelper.git/blobdiff - Debian/Debhelper/Dh_Lib.pm
r472: * Fixed issues with extended parameters to dh_gencontrol including spaces
[debhelper.git] / Debian / Debhelper / Dh_Lib.pm
index 22e9c3885620b14bda8beac88447ddfa93ca0611..92eae0c7af567d56a955998027062bfc02ab843c 100644 (file)
@@ -12,7 +12,7 @@ use vars qw(@ISA @EXPORT %dh);
 @ISA=qw(Exporter);
 @EXPORT=qw(&init &doit &complex_doit &verbose_print &error &warning &tmpdir
            &pkgfile &pkgext &isnative &autoscript &filearray &GetPackages
-           &xargs %dh);
+           &basename &xargs %dh &compat);
 
 my $max_compat=3;
 
@@ -60,9 +60,7 @@ sub init {
        # the default, doing them all.
        if (! defined $dh{DOPACKAGES} || ! @{$dh{DOPACKAGES}}) {
                if ($dh{DOINDEP} || $dh{DOARCH} || $dh{DOSAME}) {
-                       # User specified that all arch (in)dep package be 
-                       # built, and there are none of that type.
-                       error("I have no package to act on");
+                       error("You asked that all arch in(dep) packages be built, but there are none of that type.");
                }
                push @{$dh{DOPACKAGES}},@allpackages;
        }
@@ -77,21 +75,34 @@ sub init {
        # This package gets special treatement: files and directories specified on
        # the command line may affect it.
        $dh{FIRSTPACKAGE}=${$dh{DOPACKAGES}}[0];
-
-       # Split the U_PARAMS up into an array.
-       my $u=$dh{U_PARAMS};
-       undef $dh{U_PARAMS};
-       if (defined $u) {
-               push @{$dh{U_PARAMS}}, split(/\s+/,$u);
-       }
 }
 
-# Escapes out shell metacharacters in a line of shell script.
+# Pass it an array containing the arguments of a shell command like would
+# be run by exec(). It turns that into a line like you might enter at the
+# shell, escaping metacharacters and quoting qrguments that contain spaces.
 sub escape_shell {
-       my $line=shift;
-       # This list is from _Unix in a Nutshell_. (except '#')
-       $line~s/([\s!"\$()*+#;<>?@\[\]\\`|~])/\\$1/g;
-       return $line;
+       my @args=@_;
+       my $line="";
+       my @ret;
+       foreach my $word (@args) {
+               if ($word=~/\s/) {
+                       # Escape only a few things since it will be quoted.
+                       # Note we use double quotes because you cannot
+                       # escape ' in qingle quotes, while " can be escaped
+                       # in double.
+                       # This does make -V"foo bar" turn into "-Vfoo bar",
+                       # but that will be parsed identically by the shell
+                       # anyway..
+                       $word=~s/([\n`\$"\\])/\$1/g;
+                       push @ret, "\"$word\"";
+               }
+               else {
+                       # This list is from _Unix in a Nutshell_. (except '#')
+                       $word=~s/([\s!"\$()*+#;<>?@\[\]\\`|~])/\\$1/g;
+                       push @ret,$word;
+               }
+       }
+       return join(' ', @ret);
 }
 
 # Run a command, and display the command to stdout if verbose mode is on.
@@ -101,8 +112,8 @@ sub escape_shell {
 # Note that this cannot handle complex commands, especially anything
 # involving redirection. Use complex_doit instead.
 sub doit {
-       verbose_print(join(" ",map { escape_shell($_) } @_));
-       
+       verbose_print(escape_shell(@_));
+
        if (! $dh{NO_ACT}) {
                system(@_) == 0 || error("command returned error code");
        }
@@ -131,6 +142,7 @@ sub xargs {
 
         # The kernel can accept command lines up to 20k worth of characters.
        my $command_max=20000; # LINUX SPECIFIC!!
+                       # I could use POSIX::ARG_MAX, but that would be slow.
 
        # Figure out length of static portion of command.
        my $static_length=0;
@@ -261,10 +273,10 @@ sub pkgfile {
 sub pkgext {
        my $package=shift;
 
-       if ($package ne $dh{MAINPACKAGE}) {
-               return "$package.";
+       if (compat(1) and $package eq $dh{MAINPACKAGE}) {
+               return "";
        }
-       return "";
+       return "$package.";
 }
 
 # Returns 1 if the package is a native debian package, null otherwise.
@@ -339,18 +351,26 @@ sub autoscript {
 }
 
 # Reads in the specified file, one word at a time, and returns an array of
-# the result. Pass in a true value for the second parameter if the contents
-# of the file are filenames that can be glob expanded.
+# the result. If a value is passed in as the second parameter, then glob
+# expansion is done in the directory specified by the parameter ("." is
+# frequently a good choice).
 sub filearray {
        my $file=shift;
-       my $doglob=shift || '';
+       my $globdir=shift;
 
        my @ret;
-       open (DH_FARRAY_IN,"<$file") || error("cannot read $file: $1");
+       open (DH_FARRAY_IN, $file) || error("cannot read $file: $1");
        while (<DH_FARRAY_IN>) {
                # Only do glob expansion in v3 mode.
-               if ($doglob && compat(3)) {
-                       push @ret, map glob, split;
+               #
+               # The tricky bit is that the glob expansion is done
+               # as if we were in the specified directory, so the
+               # filenames that come out are relative to it.
+               if (defined $globdir && ! compat(2)) {
+                       for (map { glob "$globdir/$_" } split) {
+                               s#^$globdir/##;
+                               push @ret, $_;
+                       }
                }
                else {
                        push @ret, split;
@@ -392,7 +412,7 @@ sub GetPackages {
        my $package="";
        my $arch="";
        my @list=();
-       open (CONTROL,"<debian/control") ||
+       open (CONTROL, 'debian/control') ||
                error("cannot read debian/control: $!\n");
        while (<CONTROL>) {
                chomp;