introduce $debugprefix and debugprint etc.

diff --git a/dgit b/dgit
index 594281daa42a088ab162137abf5e68f0a6492d1f..d287cfe742cde72567cb011e9d2262b84180b52a 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -113,6 +113,9 @@ sub dscfn ($) {
 sub changesopts () { return @changesopts[1..$#changesopts]; }
 
 our $us = 'dgit';
 sub changesopts () { return @changesopts[1..$#changesopts]; }
 
 our $us = 'dgit';

+our $debugprefix = ' ';
+
+sub printdebug { print DEBUG $debugprefix, @_ or die $!; }

 
 sub fail { die "$us: @_\n"; }
 
 
 sub fail { die "$us: @_\n"; }
 


@@ -231,7 +234,7 @@ sub responder_send_command ($) {
     my ($command) = @_;
     return unless $we_are_responder;
     # called even without $we_are_responder
     my ($command) = @_;
     return unless $we_are_responder;
     # called even without $we_are_responder

-    print DEBUG "<< $command\n";
+    printdebug "<< $command\n";

     print $command, "\n" or die $!;
 }    
 
     print $command, "\n" or die $!;
 }    
 


@@ -324,7 +327,7 @@ sub failedcmd {
 }
 
 sub runcmd {
 }
 
 sub runcmd {

-    printcmd(\*DEBUG,"+",@_) if $debug>0;
+    printcmd(\*DEBUG,$debugprefix."+",@_) if $debug>0;

     $!=0; $?=0;
     failedcmd @_ if system @_;
 }
     $!=0; $?=0;
     failedcmd @_ if system @_;
 }


@@ -339,16 +342,16 @@ sub printdone {
 
 sub cmdoutput_errok {
     die Dumper(\@_)." ?" if grep { !defined } @_;
 
 sub cmdoutput_errok {
     die Dumper(\@_)." ?" if grep { !defined } @_;

-    printcmd(\*DEBUG,"|",@_) if $debug>0;
+    printcmd(\*DEBUG,$debugprefix."|",@_) if $debug>0;

     open P, "-|", @_ or die $!;
     my $d;
     $!=0; $?=0;
     { local $/ = undef; $d = <P>; }
     die $! if P->error;
     open P, "-|", @_ or die $!;
     my $d;
     $!=0; $?=0;
     { local $/ = undef; $d = <P>; }
     die $! if P->error;

-    if (!close P) { print DEBUG "=>!$?\n" if $debug>0; return undef; }
+    if (!close P) { printdebug "=>!$?\n" if $debug>0; return undef; }

     chomp $d;
     $d =~ m/^.*/;
     chomp $d;
     $d =~ m/^.*/;

-    print DEBUG "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #';
+    printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #';

     return $d;
 }
 
     return $d;
 }
 


@@ -359,7 +362,7 @@ sub cmdoutput {
 }
 
 sub dryrun_report {
 }
 
 sub dryrun_report {

-    printcmd(\*STDERR,"#",@_);
+    printcmd(\*STDERR,$debugprefix."#",@_);

 }
 
 sub runcmd_ordryrun {
 }
 
 sub runcmd_ordryrun {


@@ -640,9 +643,9 @@ sub get_archive_dsc () {
            next;
        }
        my $dscfh = new IO::File \$dscdata, '<' or die $!;
            next;
        }
        my $dscfh = new IO::File \$dscdata, '<' or die $!;

-       print DEBUG Dumper($dscdata) if $debug>1;
+       printdebug Dumper($dscdata) if $debug>1;

        $dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
        $dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);

-       print DEBUG Dumper($dsc) if $debug>1;
+       printdebug Dumper($dsc) if $debug>1;

        my $fmt = getfield $dsc, 'Format';
        fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
        return;
        my $fmt = getfield $dsc, 'Format';
        fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
        return;


@@ -914,7 +917,7 @@ sub fetch_from_archive () {
     } else {
        die "$lrref_fn $!";
     }
     } else {
        die "$lrref_fn $!";
     }

-    print DEBUG "previous reference hash=$lastpush_hash\n";
+    printdebug "previous reference hash=$lastpush_hash\n";

     my $hash;
     if (defined $dsc_hash) {
        fail "missing git history even though dsc has hash -".
     my $hash;
     if (defined $dsc_hash) {
        fail "missing git history even though dsc has hash -".


@@ -948,7 +951,7 @@ Package not found in the archive, but has allegedly been pushed using dgit.
 $later_warning_msg
 END
     } else {
 $later_warning_msg
 END
     } else {

-       print DEBUG "nothing found!\n";
+       printdebug "nothing found!\n";

        if (defined $skew_warning_vsn) {
            print STDERR <<END or die $!;
 
        if (defined $skew_warning_vsn) {
            print STDERR <<END or die $!;
 


@@ -960,7 +963,7 @@ END
        }
        return 0;
     }
        }
        return 0;
     }

-    print DEBUG "current hash=$hash\n";
+    printdebug "current hash=$hash\n";

     if ($lastpush_hash) {
        fail "not fast forward on last upload branch!".
            " (archive's version left in DGIT_ARCHIVE)"
     if ($lastpush_hash) {
        fail "not fast forward on last upload branch!".
            " (archive's version left in DGIT_ARCHIVE)"


@@ -968,13 +971,13 @@ END
     }
     if (defined $skew_warning_vsn) {
        mkpath '.git/dgit';
     }
     if (defined $skew_warning_vsn) {
        mkpath '.git/dgit';

-       print DEBUG "SKEW CHECK WANT $skew_warning_vsn\n";
+       printdebug "SKEW CHECK WANT $skew_warning_vsn\n";

        my $clogf = ".git/dgit/changelog.tmp";
        runcmd shell_cmd "exec >$clogf",
            @git, qw(cat-file blob), "$hash:debian/changelog";
        my $gotclogp = parsechangelog("-l$clogf");
        my $got_vsn = getfield $gotclogp, 'Version';
        my $clogf = ".git/dgit/changelog.tmp";
        runcmd shell_cmd "exec >$clogf",
            @git, qw(cat-file blob), "$hash:debian/changelog";
        my $gotclogp = parsechangelog("-l$clogf");
        my $got_vsn = getfield $gotclogp, 'Version';

-       print DEBUG "SKEW CHECK GOT $got_vsn\n";
+       printdebug "SKEW CHECK GOT $got_vsn\n";

        if (version_compare_string($got_vsn, $skew_warning_vsn) < 0) {
            print STDERR <<END or die $!;
 
        if (version_compare_string($got_vsn, $skew_warning_vsn) < 0) {
            print STDERR <<END or die $!;
 


@@ -1038,7 +1041,7 @@ sub pull () {
 sub check_not_dirty () {
     return if $ignoredirty;
     my @cmd = (@git, qw(diff --quiet HEAD));
 sub check_not_dirty () {
     return if $ignoredirty;
     my @cmd = (@git, qw(diff --quiet HEAD));

-    printcmd(\*DEBUG,"+",@cmd) if $debug>0;
+    printcmd(\*DEBUG,$debugprefix."+",@cmd) if $debug>0;

     $!=0; $?=0; system @cmd;
     return if !$! && !$?;
     if (!$! && $?==256) {
     $!=0; $?=0; system @cmd;
     return if !$! && !$?;
     if (!$! && $?==256) {


@@ -1173,7 +1176,7 @@ sub sign_changes ($) {
 }
 
 sub dopush () {
 }
 
 sub dopush () {

-    print DEBUG "actually entering push\n";
+    printdebug "actually entering push\n";

     prep_ud();
 
     my $clogpfn = ".git/dgit/changelog.822.tmp";
     prep_ud();
 
     my $clogpfn = ".git/dgit/changelog.822.tmp";


@@ -1193,7 +1196,7 @@ sub dopush () {
     push_parse_dsc("../$dscfn", $dscfn, $cversion);
 
     my $format = getfield $dsc, 'Format';
     push_parse_dsc("../$dscfn", $dscfn, $cversion);
 
     my $format = getfield $dsc, 'Format';

-    print DEBUG "format $format\n";
+    printdebug "format $format\n";

     if (madformat($format)) {
        commit_quilty_patch();
     }
     if (madformat($format)) {
        commit_quilty_patch();
     }


@@ -1203,8 +1206,8 @@ sub dopush () {
     runcmd qw(dpkg-source -x --), "../../../../$dscfn";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
     chdir '../../../..' or die $!;
     runcmd qw(dpkg-source -x --), "../../../../$dscfn";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
     chdir '../../../..' or die $!;

-    printcmd \*DEBUG,"+",@_;

     my @diffcmd = (@git, qw(diff --exit-code), $tree);
     my @diffcmd = (@git, qw(diff --exit-code), $tree);

+    printcmd \*DEBUG,$debugprefix."+",@diffcmd;

     $!=0; $?=0;
     if (system @diffcmd) {
        if ($! && $?==256) {
     $!=0; $?=0;
     if (system @diffcmd) {
        if ($! && $?==256) {


@@ -1397,6 +1400,7 @@ sub cmd_remote_push_responder {
     my ($dir) = @rargs;
     chdir $dir or die "$dir: $!";
     $we_are_responder = 1;
     my ($dir) = @rargs;
     chdir $dir or die "$dir: $!";
     $we_are_responder = 1;

+    $debugprefix = ' ';

     $|=1;
     responder_send_command("dgit-remote-push-ready");
     &cmd_push;
     $|=1;
     responder_send_command("dgit-remote-push-ready");
     &cmd_push;


@@ -1434,7 +1438,7 @@ sub cmd_rpush {
     push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
     push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);

-    printcmd \*DEBUG,"+",@cmd;
+    printcmd \*DEBUG,$debugprefix."+",@cmd;

     eval {
        $i_tmp = tempdir();
        my $pid = open2(\*RO, \*RI, @cmd);
     eval {
        $i_tmp = tempdir();
        my $pid = open2(\*RO, \*RI, @cmd);