@EXPORT = qw(setup_sigwarn forkcheck_setup forkcheck_mainprocess
dep14_version_mangle
debiantags debiantag_old debiantag_new
+ debiantag_maintview
+ upstreamversion
+ stripepoch source_file_leafname is_orig_file_of_p_v
server_branch server_ref
stat_exists link_ltarget
hashfile
git_reflog_action_msg git_update_ref_cmd
$package_re $component_re $deliberately_re
$distro_re $versiontag_re $series_filename_re
+ $orig_f_comp_re $orig_f_sig_re $orig_f_tail_re
$extra_orig_namepart_re
$git_null_obj
$branchprefix
$ffq_refprefix $gdrlast_refprefix
initdebug enabledebug enabledebuglevel
printdebug debugcmd
+ $printdebug_when_debuglevel $debugcmd_when_debuglevel
$debugprefix *debuglevel *DEBUG
shellquote printcmd messagequote
$negate_harmful_gitattrs
our $branchprefix = 'dgit';
our $series_filename_re = qr{(?:^|\.)series(?!\n)$}s;
our $extra_orig_namepart_re = qr{[-0-9a-z]+};
+our $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?};
+our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
+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
}
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 ($) {
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 ($) {
return "archive/$distro/".dep14_version_mangle $v;
}
+sub debiantag_maintview ($$) {
+ my ($v,$distro) = @_;
+ return "$distro/".dep14_version_mangle $v;
+}
+
sub debiantags ($$) {
my ($version,$distro) = @_;
map { $_->($version, $distro) } (\&debiantag_new, \&debiantag_old);
}
+sub stripepoch ($) {
+ my ($vsn) = @_;
+ $vsn =~ s/^\d+\://;
+ return $vsn;
+}
+
+sub upstreamversion ($) {
+ my ($vsn) = @_;
+ $vsn =~ s/-[^-]+$//;
+ return $vsn;
+}
+
+sub source_file_leafname ($$$) {
+ my ($package,$vsn,$sfx) = @_;
+ return "${package}_".(stripepoch $vsn).$sfx
+}
+
+sub is_orig_file_of_p_v ($$$) {
+ my ($f, $package, $upstreamvsn) = @_;
+ my $base = source_file_leafname $package, $upstreamvsn, '';
+ return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/;
+ return 1;
+}
+
sub server_branch ($) { return "$branchprefix/$_[0]"; }
sub server_ref ($) { return "refs/".server_branch($_[0]); }
sub cmdoutput_errok {
confess Dumper(\@_)." ?" if grep { !defined } @_;
+ local $printdebug_when_debuglevel = $debugcmd_when_debuglevel;
debugcmd "|",@_;
open P, "-|", @_ or die "$_[0] $!";
my $d;
# 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) {