X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=f166f11b58464b7d9616579fb3af89f4ef01a41d;hp=c39ff72e6e2c9e388f3c0a473244f42b02500e38;hb=89506141b188407123bf605d2b051f2dfa10ad4b;hpb=96ac307f0b9d186d589d221dabfb0e403169aa08 diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index c39ff72e..f166f11b 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -6,6 +6,7 @@ use strict; use warnings; use POSIX; +use IO::Handle; BEGIN { use Exporter (); @@ -15,7 +16,10 @@ BEGIN { @ISA = qw(Exporter); @EXPORT = qw(debiantag server_branch server_ref stat_exists git_for_each_ref - $package_re $component_re $branchprefix); + $package_re $component_re $branchprefix + initdebug enabledebug printdebug debugcmd + $debugprefix *debuglevel *DEBUG + shellquote printcmd); %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO)] ); @EXPORT_OK = @{ $EXPORT_TAGS{policyflags} }; } @@ -29,9 +33,9 @@ our $branchprefix = 'dgit'; # policy hook exit status bits # see dgit-repos-server head comment for documentation # 1 is reserved in case something fails with `exit 1' -sub NOFFCHECK () { return 2; } -sub FRESHREPO () { return 4; } -# 128 is reserved +sub NOFFCHECK () { return 0x2; } +sub FRESHREPO () { return 0x4; } +# 0x80 is reserved sub debiantag ($) { my ($v) = @_; @@ -73,4 +77,50 @@ sub git_for_each_tag_referring ($$) { }); } +our $debugprefix; +our $debuglevel = 0; + +sub initdebug ($) { + ($debugprefix) = @_; + open DEBUG, ">/dev/null" or die $!; +} + +sub enabledebug () { + open DEBUG, ">&STDERR" or die $!; + DEBUG->autoflush(1); + $debuglevel ||= 1; +} + +sub printdebug { + print DEBUG $debugprefix, @_ or die $! if $debuglevel>0; +} + +sub shellquote { + my @out; + local $_; + foreach my $a (@_) { + $_ = $a; + if (m{[^-=_./0-9a-z]}i) { + s{['\\]}{'\\$&'}g; + push @out, "'$_'"; + } else { + push @out, $_; + } + } + return join ' ', @out; +} + +sub printcmd { + my $fh = shift @_; + my $intro = shift @_; + print $fh $intro," " or die $!; + print $fh shellquote @_ or die $!; + print $fh "\n" or die $!; +} + +sub debugcmd { + my $extraprefix = shift @_; + printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0; +} + 1;