use File::Path;
use File::Basename;
use Dpkg::Control::Hash;
+use Debian::Dgit::ExitStatus;
BEGIN {
use Exporter ();
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
git_for_each_tag_referring is_fast_fwd
git_check_unmodified
git_reflog_action_msg git_update_ref_cmd
+ make_commit_text
+ reflog_cache_insert reflog_cache_lookup
$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
$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 $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;
+
+# these three all go together, only valid after record_maindir
+our $maindir;
+our $maindir_gitdir;
+our $maindir_gitcommon;
# 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 $vsn;
}
+sub upstreamversion ($) {
+ my ($vsn) = @_;
+ $vsn =~ s/-[^-]+$//;
+ return $vsn;
+}
+
sub source_file_leafname ($$$) {
my ($package,$vsn,$sfx) = @_;
return "${package}_".(stripepoch $vsn).$sfx
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;
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) {
close CLOGS or $?==SIGPIPE or failedcmd @$clogcmd;
}
+sub make_commit_text ($) {
+ my ($text) = @_;
+ my ($out, $in);
+ my @cmd = (qw(git hash-object -w -t commit --stdin));
+ debugcmd "|",@cmd;
+ print Dumper($text) if $debuglevel > 1;
+ my $child = open2($out, $in, @cmd) or die $!;
+ my $h;
+ eval {
+ print $in $text or die $!;
+ close $in or die $!;
+ $h = <$out>;
+ $h =~ m/^\w+$/ or die;
+ $h = $&;
+ printdebug "=> $h\n";
+ };
+ close $out;
+ waitpid $child, 0 == $child or die "$child $!";
+ $? and failedcmd @cmd;
+ return $h;
+}
+
+sub reflog_cache_insert ($$$) {
+ my ($ref, $cachekey, $value) = @_;
+ # you must call this in $maindir
+ # you must have called record_maindir
+
+ # When we no longer need to support squeeze, use --create-reflog
+ # instead of this:
+ my $parent = $ref; $parent =~ s{/[^/]+$}{};
+ ensuredir "$maindir_gitcommon/logs/$parent";
+ my $makelogfh = new IO::File "$maindir_gitcommon/logs/$ref", '>>'
+ or die $!;
+
+ my $oldcache = git_get_ref $ref;
+
+ if ($oldcache eq $value) {
+ my $tree = cmdoutput qw(git rev-parse), "$value:";
+ # git update-ref doesn't always update, in this case. *sigh*
+ my $authline = (ucfirst _us()).
+ ' <'._us().'@example.com> 1000000000 +0000';
+ my $dummy = make_commit_text <<END;
+tree $tree
+parent $value
+author $authline
+committer $authline
+
+Dummy commit - do not use
+END
+ runcmd qw(git update-ref -m), _us()." - dummy", $ref, $dummy;
+ }
+ runcmd qw(git update-ref -m), $cachekey, $ref, $value;
+}
+
+sub reflog_cache_lookup ($$) {
+ my ($ref, $cachekey) = @_;
+ # you may call this in $maindir or in a playtree
+ # you must have called record_maindir
+ my @cmd = (qw(git log -g), '--pretty=format:%H %gs', $ref);
+ debugcmd "|(probably)",@cmd;
+ my $child = open GC, "-|"; defined $child or die $!;
+ if (!$child) {
+ chdir $maindir or die $!;
+ if (!stat "$maindir_gitcommon/logs/$ref") {
+ $! == ENOENT or die $!;
+ printdebug ">(no reflog)\n";
+ finish 0;
+ }
+ exec @cmd; die $!;
+ }
+ while (<GC>) {
+ chomp;
+ printdebug ">| ", $_, "\n" if $debuglevel > 1;
+ next unless m/^(\w+) (\S.*\S)$/ && $2 eq $cachekey;
+ close GC;
+ return $1;
+ }
+ die $! if GC->error;
+ failedcmd unless close GC;
+ return undef;
+}
+
# ========== playground handling ==========
# terminology:
# ----- maindir -----
-# these three all go together
-our $maindir;
-our $maindir_gitdir;
-our $maindir_gitcommon;
-
our $local_git_cfg;
sub record_maindir () {
~ianmdlvl / dgit.git / blobdiff