X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=Debian%2FDgit.pm;h=b1aa620366daefb40079b287ea400c458dab42e2;hb=b30764495d682a756d2b3bd13935c3be46a0d339;hp=1cd765df979067bf6b3c2424dfcac0161709e794;hpb=21e1afc5f7963a0223207d8284f2f2d0d382cc6f;p=dgit.git

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index 1cd765df..b1aa6203 100644
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -32,6 +32,8 @@ use IPC::Open2;
 use File::Path;
 use File::Basename;
 use Dpkg::Control::Hash;
+use Debian::Dgit::ExitStatus;
+use Debian::Dgit::I18n;
 
 BEGIN {
     use Exporter   ();
@@ -57,6 +59,8 @@ BEGIN {
                       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
@@ -66,6 +70,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 +105,13 @@ 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;
+
+# 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
@@ -156,7 +168,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 +221,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 +293,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 +389,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 +442,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) {
@@ -643,7 +672,7 @@ sub getfield ($$) {
     my ($dctrl,$field) = @_;
     my $v = $dctrl->{$field};
     return $v if defined $v;
-    fail "missing field $field in ".$dctrl->get_option('name');
+    fail ___ "missing field %s in %s", $field, $dctrl->get_option('name');
 }
 
 sub parsechangelog_loop ($$$) {
@@ -667,6 +696,88 @@ sub parsechangelog_loop ($$$) {
     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:
@@ -715,11 +826,6 @@ sub parsechangelog_loop ($$$) {
 
 # ----- maindir -----
 
-# these three all go together
-our $maindir;
-our $maindir_gitdir;
-our $maindir_gitcommon;
-
 our $local_git_cfg;
 
 sub record_maindir () {