X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=Debian%2FDgit.pm;h=c2b7f670012ee2293ac57b72ce36b683f4c2c26f;hb=991b8c9a6bba8aeec02cb1b3d39e3f9e8d941a29;hp=00b4aa5460869611a42436de52f4a3ffe53df8fc;hpb=e6ce71a87a1ca14ce90fc78023725d9f3bec54ee;p=dgit.git

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index 00b4aa54..c2b7f670 100644
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -16,10 +16,10 @@ BEGIN {
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
     @EXPORT      = qw(debiantag server_branch server_ref
-                      stat_exists fail waitstatusmsg failedcmd
+                      stat_exists fail ensuredir waitstatusmsg failedcmd
                       cmdoutput cmdoutput_errok
-                      git_for_each_ref
-                      git_for_each_tag_referring
+                      git_rev_parse git_for_each_ref
+                      git_for_each_tag_referring is_fast_fwd
                       $package_re $component_re $deliberately_re
                       $branchprefix
                       initdebug enabledebug enabledebuglevel
@@ -128,6 +128,13 @@ sub fail {
     die $s;
 }
 
+sub ensuredir ($) {
+    my ($dir) = @_; # does not create parents
+    return if mkdir $dir;
+    return if $! == EEXIST;
+    die "mkdir $dir: $!";
+}
+
 our @signames = split / /, $Config{sig_name};
 
 sub waitstatusmsg () {
@@ -177,6 +184,10 @@ sub cmdoutput {
     return $d;
 }
 
+sub git_rev_parse ($) {
+    return cmdoutput qw(git rev-parse), "$_[0]~0";
+}
+
 sub git_for_each_ref ($$) {
     my ($pattern,$func) = @_;
     # calls $func->($objid,$objtype,$fullrefname,$reftail);
@@ -196,15 +207,31 @@ sub git_for_each_ref ($$) {
 
 sub git_for_each_tag_referring ($$) {
     my ($objreferring, $func) = @_;
-    # calls $func->($objid,$fullrefname,$tagname);
+    # calls $func->($tagobjid,$refobjid,$fullrefname,$tagname);
     printdebug "git_for_each_tag_referring ",
         ($objreferring // 'UNDEF'),"\n";
     git_for_each_ref('refs/tags', sub {
-	my ($objid,$objtype,$fullrefname,$tagname) = @_;
+	my ($tagobjid,$objtype,$fullrefname,$tagname) = @_;
 	return unless $objtype eq 'tag';
-	return if defined $objreferring and $objid ne $objreferring;
-	$func->($objid,$fullrefname,$tagname);
+	my $refobjid = git_rev_parse $tagobjid;
+	return unless
+	    !defined $objreferring # caller wants them all
+	    or $tagobjid eq $objreferring
+	    or $refobjid eq $objreferring;
+	$func->($tagobjid,$refobjid,$fullrefname,$tagname);
     });
 }
 
+sub is_fast_fwd ($$) {
+    my ($ancestor,$child) = @_;
+    my @cmd = (qw(git merge-base), $ancestor, $child);
+    my $mb = cmdoutput_errok @cmd;
+    if (defined $mb) {
+	return git_rev_parse($mb) eq git_rev_parse($ancestor);
+    } else {
+	$?==256 or failedcmd @cmd;
+	return 0;
+    }
+}
+
 1;