X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=f68b7c9113404ae7fb46c0475daaaf90da5cdf31;hp=67db526d311cdb2d4462a88741e9440deb0aa87a;hb=332806a67a034c88c2884b516ce2aaf8b317dd25;hpb=1d853dafdff2782206dfc39be74ca372b32f09eb diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 67db526d..f68b7c91 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -66,7 +66,7 @@ BEGIN { $ffq_refprefix $gdrlast_refprefix initdebug enabledebug enabledebuglevel printdebug debugcmd - $printdebug_when_debuglevel + $printdebug_when_debuglevel $debugcmd_when_debuglevel $debugprefix *debuglevel *DEBUG shellquote printcmd messagequote $negate_harmful_gitattrs @@ -102,6 +102,7 @@ our $git_null_obj = '0' x 40; our $ffq_refprefix = 'ffq-prev'; our $gdrlast_refprefix = 'debrebase-last'; our $printdebug_when_debuglevel = 1; +our $debugcmd_when_debuglevel = 1; # policy hook exit status bits # see dgit-repos-server head comment for documentation @@ -158,8 +159,21 @@ sub enabledebuglevel ($) { } sub printdebug { - print DEBUG $debugprefix, @_ or die $! - if $debuglevel >= $printdebug_when_debuglevel; + # Prints a prefix, and @_, to DEBUG. @_ should normally contain + # a trailing \n. + + # With no (or only empty) arguments just prints the prefix and + # leaves the caller to do more with DEBUG. The caller should make + # sure then to call printdebug with something ending in "\n" to + # get the prefix right in subsequent calls. + + return unless $debuglevel >= $printdebug_when_debuglevel; + our $printdebug_noprefix; + print DEBUG $debugprefix unless $printdebug_noprefix; + pop @_ while @_ and !length $_[-1]; + return unless @_; + print DEBUG @_ or die $!; + $printdebug_noprefix = $_[-1] !~ m{\n$}; } sub messagequote ($) { @@ -198,7 +212,8 @@ sub printcmd { sub debugcmd { my $extraprefix = shift @_; - printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0; + printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) + if $debuglevel >= $debugcmd_when_debuglevel; } sub dep14_version_mangle ($) { @@ -269,7 +284,7 @@ sub _us () { sub failmsg { my $s = "error: @_\n"; - $s =~ s/\n\n$/\n/; + $s =~ s/\n\n$/\n/g; my $prefix = _us().": "; $s =~ s/^/$prefix/gm; return "\n".$s; @@ -365,6 +380,7 @@ sub shell_cmd { sub cmdoutput_errok { confess Dumper(\@_)." ?" if grep { !defined } @_; + local $printdebug_when_debuglevel = $debugcmd_when_debuglevel; debugcmd "|",@_; open P, "-|", @_ or die "$_[0] $!"; my $d; @@ -417,6 +433,7 @@ sub git_cat_file ($;$) { # in scalar context, just the data # if $etype defined, dies unless type is $etype or in @$etype our ($gcf_pid, $gcf_i, $gcf_o); + local $printdebug_when_debuglevel = $debugcmd_when_debuglevel; my $chk = sub { my ($gtype, $data) = @_; if ($etype) {