X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=37cbc51b68e52116705d1988cf040eef36919bda;hp=f20f1bc44c719d918ea0cb8cf689b13cdaeb4223;hb=36393a3544aa58377762b4e8b4b319c301bed878;hpb=2f169a239c0ad428328fa2415649dc05318618bb diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index f20f1bc4..37cbc51b 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -16,9 +16,9 @@ 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_rev_parse git_for_each_ref + git_rev_parse git_get_ref git_for_each_ref git_for_each_tag_referring is_fast_fwd $package_re $component_re $deliberately_re $branchprefix @@ -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 () { @@ -181,33 +188,48 @@ sub git_rev_parse ($) { return cmdoutput qw(git rev-parse), "$_[0]~0"; } -sub git_for_each_ref ($$) { - my ($pattern,$func) = @_; +sub git_for_each_ref ($$;$) { + my ($pattern,$func,$gitdir) = @_; # calls $func->($objid,$objtype,$fullrefname,$reftail); - # $reftail is RHS of ref after refs/\w+/ + # $reftail is RHS of ref after refs/[^/]+/ # breaks if $pattern matches any ref `refs/blah' where blah has no `/' my @cmd = (qw(git for-each-ref), $pattern); + if (defined $gitdir) { + @cmd = ('sh','-ec','cd "$1"; shift; exec "$@"','x', $gitdir, @cmd); + } open GFER, "-|", @cmd or die $!; debugcmd "|", @cmd; while () { chomp or die "$_ ?"; printdebug "|> ", $_, "\n"; - m#^(\w+)\s+(\w+)\s+(refs/\w+/(\S+))$# or die "$_ ?"; + m#^(\w+)\s+(\w+)\s+(refs/[^/]+/(\S+))$# or die "$_ ?"; $func->($1,$2,$3,$4); } $!=0; $?=0; close GFER or die "$pattern $? $!"; } +sub git_get_ref ($) { + # => '' if no such ref + my ($refname) = @_; + local $_ = $refname; + s{^refs/}{[r]efs/} or die "$refname $_ ?"; + return cmdoutput qw(git for-each-ref --format=%(objectname)), $_; +} + 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); }); }