X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=f68b7c9113404ae7fb46c0475daaaf90da5cdf31;hp=1cd765df979067bf6b3c2424dfcac0161709e794;hb=d471fbd414ac2d25ae0f6b7693c5f15272cd80ee;hpb=21e1afc5f7963a0223207d8284f2f2d0d382cc6f diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 1cd765df..f68b7c91 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -66,6 +66,7 @@ BEGIN { $ffq_refprefix $gdrlast_refprefix initdebug enabledebug enabledebuglevel printdebug debugcmd + $printdebug_when_debuglevel $debugcmd_when_debuglevel $debugprefix *debuglevel *DEBUG shellquote printcmd messagequote $negate_harmful_gitattrs @@ -100,6 +101,8 @@ our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?"; 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 @@ -156,7 +159,21 @@ sub enabledebuglevel ($) { } sub printdebug { - print DEBUG $debugprefix, @_ or die $! if $debuglevel>0; + # 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 ($) { @@ -195,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 ($) { @@ -266,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; @@ -362,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; @@ -414,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) {